/[MITgcm]/MITgcm/pkg/obcs/obcs_prescribe_read.F
ViewVC logotype

Diff of /MITgcm/pkg/obcs/obcs_prescribe_read.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.28 by mlosch, Mon Mar 14 17:05:39 2011 UTC revision 1.29 by jmc, Sun Apr 17 03:20:51 2011 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  # include "OBCS_OPTIONS.h"  # include "OBCS_OPTIONS.h"
5    
6        subroutine obcs_prescribe_read (  CBOP
7       I                      mycurrenttime  C     !ROUTINE: OBCS_PRESCRIBE_READ
8       I                    , mycurrentiter  C     !INTERFACE:
9       I                    , mythid        SUBROUTINE OBCS_PRESCRIBE_READ (
10       &                     )       I                          myTime, myIter, myThid )
11  c     |==================================================================|  
12  c     | SUBROUTINE obcs_prescribe_read                                   |  C     !DESCRIPTION: \bv
13  c     |==================================================================|  C     *============================================================*
14  c     | read open boundary conditions from file                          |  C     | SUBROUTINE OBCS_PRESCRIBE_READ
15  c     | N.B.: * uses exf and cal routines for file/record handling       |  C     *============================================================*
16  c     |       * uses ctrl routines for control variable handling         |  C     | read open boundary conditions from file                          
17  c     |==================================================================|  C     | N.B.: * uses exf and cal routines for file/record handling        
18    C     |       * uses ctrl routines for control variable handling          
19    C     *============================================================*
20    C     \ev
21    
22        implicit none  C     !USES:
23          IMPLICIT NONE
 c     == global variables ==  
24    
25    C     == global variables ==
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "OBCS.h"  c#include "OBCS.h"
30  #ifdef ALLOW_EXF  c#ifdef ALLOW_EXF
31  # include "EXF_PARAM.h"  c# include "EXF_PARAM.h"
32  #endif  c#endif
33  #ifdef ALLOW_PTRACERS  c#ifdef ALLOW_PTRACERS
34  # include "PTRACERS_SIZE.h"  c# include "PTRACERS_SIZE.h"
35  # include "OBCS_PTRACERS.h"  c# include "OBCS_PTRACERS.h"
36  #endif /* ALLOW_PTRACERS */  c#endif /* ALLOW_PTRACERS */
37    
38  c     == routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
39    C     myTime :: Simulation time
40        _RL     mycurrenttime  C     myIter :: Simulation timestep number
41        integer mycurrentiter  C     myThid :: my Thread Id. number
42        integer mythid        _RL     myTime
43          INTEGER myIter
44  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_PRESCRIBE))        INTEGER myThid
45    
46  c     == local variables ==  #ifdef ALLOW_OBCS_PRESCRIBE
47    
48  c     == end of interface ==  C     !LOCAL VARIABLES:
49    CEOP
50    
51  # ifdef ALLOW_EXF  # ifdef ALLOW_EXF
52        IF ( useEXF ) THEN        IF ( useEXF ) THEN
53  #  ifdef ALLOW_OBCS_NORTH          CALL OBCS_EXF_LOAD( myTime, myIter, myThid )
       call obcs_prescribe_exf_xz (  
      I     obcsNstartdate, obcsNperiod,  
      I     useOBCSYearlyFields,  
      U     OBNu,   OBNu0,   OBNu1,   OBNufile,  
      U     OBNv,   OBNv0,   OBNv1,   OBNvfile,  
      U     OBNt,   OBNt0,   OBNt1,   OBNtfile,  
      U     OBNs,   OBNs0,   OBNs1,   OBNsfile,  
 #   ifdef NONLIN_FRSURF  
      U     OBNeta, OBNeta0, OBNeta1, OBNetafile,  
 #   endif  
 #   ifdef ALLOW_SEAICE  
      I     siobNstartdate, siobNperiod,  
      U     OBNa,   OBNa0,   OBNa1,   OBNafile,  
      U     OBNh,   OBNh0,   OBNh1,   OBNhfile,  
      U     OBNsl,  OBNsl0,  OBNsl1,  OBNslfile,  
      U     OBNsn,  OBNsn0,  OBNsn1,  OBNsnfile,  
      U     OBNuice,OBNuice0,OBNuice1,OBNuicefile,  
      U     OBNvice,OBNvice0,OBNvice1,OBNvicefile,  
 #   endif  
 #   ifdef ALLOW_PTRACERS  
      U     OBNptr ,OBNptr0, OBNptr1, OBNptrFile,  
 #   endif  
      I     mycurrenttime, mycurrentiter, mythid  
      &     )  
 #  endif /* ALLOW_OBCS_NORTH */  
   
 #  ifdef ALLOW_OBCS_SOUTH  
       call obcs_prescribe_exf_xz (  
      I     obcsSstartdate, obcsSperiod,  
      I     useOBCSYearlyFields,  
      U     OBSu,   OBSu0,   OBSu1,   OBSufile,  
      U     OBSv,   OBSv0,   OBSv1,   OBSvfile,  
      U     OBSt,   OBSt0,   OBSt1,   OBStfile,  
      U     OBSs,   OBSs0,   OBSs1,   OBSsfile,  
 #   ifdef NONLIN_FRSURF  
      U     OBSeta, OBSeta0, OBSeta1, OBSetafile,  
 #   endif  
 #   ifdef ALLOW_SEAICE  
      I     siobSstartdate, siobSperiod,  
      U     OBSa,   OBSa0,   OBSa1,   OBSafile,  
      U     OBSh,   OBSh0,   OBSh1,   OBShfile,  
      U     OBSsl,  OBSsl0,  OBSsl1,  OBSslfile,  
      U     OBSsn,  OBSsn0,  OBSsn1,  OBSsnfile,  
      U     OBSuice,OBSuice0,OBSuice1,OBSuicefile,  
      U     OBSvice,OBSvice0,OBSvice1,OBSvicefile,  
 #   endif  
 #   ifdef ALLOW_PTRACERS  
      U     OBSptr ,OBSptr0, OBSptr1, OBSptrFile,  
 #   endif  
      I     mycurrenttime, mycurrentiter, mythid  
      &     )  
 #  endif /* ALLOW_OBCS_SOUTH */  
   
 #  ifdef ALLOW_OBCS_EAST  
       call obcs_prescribe_exf_yz (  
      I     obcsEstartdate, obcsEperiod,  
      I     useOBCSYearlyFields,  
      U     OBEu,   OBEu0,   OBEu1,   OBEufile,  
      U     OBEv,   OBEv0,   OBEv1,   OBEvfile,  
      U     OBEt,   OBEt0,   OBEt1,   OBEtfile,  
      U     OBEs,   OBEs0,   OBEs1,   OBEsfile,  
 #   ifdef NONLIN_FRSURF  
      U     OBEeta, OBEeta0, OBEeta1, OBEetafile,  
 #   endif  
 #   ifdef ALLOW_SEAICE  
      I     siobEstartdate, siobEperiod,  
      U     OBEa,   OBEa0,   OBEa1,   OBEafile,  
      U     OBEh,   OBEh0,   OBEh1,   OBEhfile,  
      U     OBEsl,  OBEsl0,  OBEsl1,  OBEslfile,  
      U     OBEsn,  OBEsn0,  OBEsn1,  OBEsnfile,  
      U     OBEuice,OBEuice0,OBEuice1,OBEuicefile,  
      U     OBEvice,OBEvice0,OBEvice1,OBEvicefile,  
 #   endif  
 #   ifdef ALLOW_PTRACERS  
      U     OBEptr ,OBEptr0, OBEptr1, OBEptrFile,  
 #   endif  
      I     mycurrenttime, mycurrentiter, mythid  
      &     )  
 #  endif /* ALLOW_OBCS_EAST */  
   
 #  ifdef ALLOW_OBCS_WEST  
       call obcs_prescribe_exf_yz (  
      I     obcsWstartdate, obcsWperiod,  
      I     useOBCSYearlyFields,  
      U     OBWu,   OBWu0,   OBWu1,   OBWufile,  
      U     OBWv,   OBWv0,   OBWv1,   OBWvfile,  
      U     OBWt,   OBWt0,   OBWt1,   OBWtfile,  
      U     OBWs,   OBWs0,   OBWs1,   OBWsfile,  
 #   ifdef NONLIN_FRSURF  
      U     OBWeta, OBWeta0, OBWeta1, OBWetafile,  
 #   endif  
 #   ifdef ALLOW_SEAICE  
      I     siobWstartdate, siobWperiod,  
      U     OBWa,   OBWa0,   OBWa1,   OBWafile,  
      U     OBWh,   OBWh0,   OBWh1,   OBWhfile,  
      U     OBWsl,  OBWsl0,  OBWsl1,  OBWslfile,  
      U     OBWsn,  OBWsn0,  OBWsn1,  OBWsnfile,  
      U     OBWuice,OBWuice0,OBWuice1,OBWuicefile,  
      U     OBWvice,OBWvice0,OBWvice1,OBWvicefile,  
 #   endif  
 #   ifdef ALLOW_PTRACERS  
      U     OBWptr ,OBWptr0, OBWptr1, OBWptrFile,  
 #   endif  
      I     mycurrenttime, mycurrentiter, mythid  
      &     )  
 #  endif /* ALLOW_OBCS_WEST */  
 C     ENDIF useEXF  
54        ENDIF        ENDIF
55  # endif /* ALLOW_EXF */  # endif /* ALLOW_EXF */
56    
57        IF ( .NOT. useEXF ) THEN        IF ( .NOT. useEXF ) THEN
58  cph#ifndef ALLOW_AUTODIFF_TAMC  cph#ifndef ALLOW_AUTODIFF_TAMC
59         CALL OBCS_EXTERNAL_FIELDS_LOAD(         CALL OBCS_FIELDS_LOAD( myTime, myIter, myThid )
      &     myCurrentTime, myCurrentIter, myThid )  
60  cph#else  cph#else
61  cph       STOP 'PH HAS DISABLED THIS RUNTIME OPTION FOR ALLOW_EXF'  cph       STOP 'PH HAS DISABLED THIS RUNTIME OPTION FOR ALLOW_EXF'
62  cph#endif  cph#endif
63        ENDIF        ENDIF
64    
65  # ifdef ALLOW_OBCSN_CONTROL  # ifdef ALLOW_OBCSN_CONTROL
66        call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )        CALL CTRL_GETOBCSN ( myTime, myIter, mythid )
67  # endif  # endif
68    
69  # ifdef ALLOW_OBCSS_CONTROL  # ifdef ALLOW_OBCSS_CONTROL
70        call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )        CALL CTRL_GETOBCSS ( myTime, myIter, mythid )
71  # endif  # endif
72    
73  # ifdef ALLOW_OBCSW_CONTROL  # ifdef ALLOW_OBCSW_CONTROL
74        call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )        CALL CTRL_GETOBCSW ( myTime, myIter, myThid )
75  # endif  # endif
76    
77  # ifdef ALLOW_OBCSE_CONTROL  # ifdef ALLOW_OBCSE_CONTROL
78        call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )        CALL CTRL_GETOBCSE ( myTime, myIter, myThid )
79  # endif  # endif
80    
81  #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE */  #endif /* ALLOW_OBCS_PRESCRIBE */
   
       RETURN  
       END  
   
   
 C=========================================================================  
 C=========================================================================  
   
       subroutine obcs_prescribe_exf_xz (  
      I     obcsstartdate, obcsperiod,  
      I     useYearlyFields,  
      U     OBu,   OBu0,   OBu1,   OBufile,  
      U     OBv,   OBv0,   OBv1,   OBvfile,  
      U     OBt,   OBt0,   OBt1,   OBtfile,  
      U     OBs,   OBs0,   OBs1,   OBsfile,  
 #ifdef NONLIN_FRSURF  
      U     OBeta, OBeta0, OBeta1, OBetafile,  
 #endif  
 #ifdef ALLOW_SEAICE  
      I     siobstartdate, siobperiod,  
      U     OBa,   OBa0,   OBa1,   OBafile,  
      U     OBh,   OBh0,   OBh1,   OBhfile,  
      U     OBsl,  OBsl0,  OBsl1,  OBslfile,  
      U     OBsn,  OBsn0,  OBsn1,  OBsnfile,  
      U     OBuice,OBuice0,OBuice1,OBuicefile,  
      U     OBvice,OBvice0,OBvice1,OBvicefile,  
 #endif  
 #ifdef ALLOW_PTRACERS  
      U     OBptr ,OBptr0, OBptr1, OBptrFile,  
 #endif  
      I     mycurrenttime, mycurrentiter, mythid  
      &     )  
 c     |==================================================================|  
 c     | SUBROUTINE obcs_prescribe_exf_xz                                 |  
 c     |==================================================================|  
 c     | read open boundary conditions from file                          |  
 c     | N.B.: * uses exf and cal routines for file/record handling       |  
 c     |       * uses ctrl routines for control variable handling         |  
 c     |==================================================================|  
   
       implicit none  
   
 c     == global variables ==  
   
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #include "PARAMS.h"  
 #ifdef ALLOW_EXF  
 # include "EXF_PARAM.h"  
 #endif  
 #ifdef ALLOW_PTRACERS  
 # include "PTRACERS_SIZE.h"  
 # include "PTRACERS_PARAMS.h"  
 #endif /* ALLOW_PTRACERS */  
   
 c     == routine arguments ==  
   
       _RL     obcsstartdate  
       _RL     obcsperiod  
       LOGICAL useYearlyFields  
       _RL OBu     (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBv     (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBt     (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBs     (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBu0    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBv0    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBt0    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBs0    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBu1    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBv1    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBt1    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       _RL OBs1    (1-Olx:sNx+Olx,Nr,nSx,nSy)  
       CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile  
 #ifdef NONLIN_FRSURF  
       _RL OBeta   (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBeta0  (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBeta1  (1-Olx:sNx+Olx,nSx,nSy)  
       CHARACTER*(MAX_LEN_FNAM) OBetaFile  
 #endif  
 #ifdef ALLOW_SEAICE  
       _RL     siobstartdate  
       _RL     siobperiod  
       _RL OBa     (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBh     (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBa0    (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBh0    (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBa1    (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBh1    (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBsl    (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBsn    (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBsl0   (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBsn0   (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBsl1   (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBsn1   (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBuice  (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBvice  (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBuice0 (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBvice0 (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBuice1 (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBvice1 (1-Olx:sNx+Olx,nSx,nSy)  
       CHARACTER*(MAX_LEN_FNAM)  
      &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile  
 #endif /* ALLOW_SEAICE */  
 #ifdef ALLOW_PTRACERS  
       _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)  
       _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)  
       _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)  
       CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)  
 #endif /* ALLOW_PTRACERS */  
       _RL     mycurrenttime  
       integer mycurrentiter  
       integer mythid  
   
 #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \  
     && defined ALLOW_EXF  
   
 c     == local variables ==  
       logical first, changed  
       integer count0, count1  
       integer year0, year1  
       _RL     fac  
 # ifdef ALLOW_PTRACERS  
       integer iTracer  
 # endif /* ALLOW_PTRACERS */  
 c     == end of interface ==  
   
       if ( obcsperiod .eq. -12. _d 0 ) then  
 c     obcsperiod=-12 means input file contains 12 monthly means  
 c     record numbers are assumed 1 to 12 corresponding to  
 c     Jan. through Dec.  
        call cal_GetMonthsRec(  
      O                        fac, first, changed,  
      O                        count0, count1,  
      I                        mycurrenttime, mycurrentiter, mythid  
      &           )  
   
       elseif ( obcsperiod .lt. 0. _d 0 ) then  
        print *, 'obcsperiod is out of range'  
        STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'  
       else  
 c     get record numbers and interpolation factor  
        call exf_GetFFieldRec(  
      I                       obcsstartdate, obcsperiod,  
      I                       useYearlyFields,  
      O                       fac, first, changed,  
      O                       count0, count1, year0, year1,  
      I                       mycurrenttime, mycurrentiter, mythid  
      &                      )  
       endif  
       call exf_set_obcs_xz(  OBu, OBu0, OBu1, OBufile, 'u'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBv, OBv0, OBv1, OBvfile, 'v'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBt, OBt0, OBt1, OBtfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBs, OBs0, OBs1, OBsfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
 # ifdef NONLIN_FRSURF  
        call exf_set_obcs_x ( OBeta, OBeta0, OBeta1, OBetaFile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
 # endif /* NONLIN_FRSURF */  
 # ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do iTracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_xz(  OBptr (1-Olx,1,1,1,iTracer)  
      I                       , OBptr0(1-Olx,1,1,1,iTracer)  
      I                       , OBptr1(1-Olx,1,1,1,iTracer)  
      I                       , OBptrFile(iTracer), 's'  
      I                       , fac, first, changed, useYearlyFields  
      I                       , obcsperiod, count0, count1, year0, year1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 # endif /* ALLOW_PTRACERS */  
 # ifdef ALLOW_SEAICE  
       IF (useSEAICE) THEN  
        if ( siobperiod .eq. -12. _d 0 ) then  
 c     siobperiod=-12 means input file contains 12 monthly means  
 c     record numbers are assumed 1 to 12 corresponding to  
 c     Jan. through Dec.  
         call cal_GetMonthsRec(  
      O                        fac, first, changed,  
      O                        count0, count1,  
      I                        mycurrenttime, mycurrentiter, mythid  
      &           )  
   
        elseif ( siobperiod .lt. 0. _d 0 ) then  
         print *, 'siobperiod is out of range'  
         STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'  
        else  
 c     get record numbers and interpolation factor  
         call exf_GetFFieldRec(  
      I                       siobstartdate, siobperiod,  
      I                       useYearlyFields,  
      O                       fac, first, changed,  
      O                       count0, count1, year0, year1,  
      I                       mycurrenttime, mycurrentiter, mythid  
      &                      )  
        endif  
        call exf_set_obcs_x (  OBa, OBa0, OBa1, OBafile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x (  OBh, OBh0, OBh1, OBhfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x (  OBsl, OBsl0, OBsl1, OBslfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x (  OBsn, OBsn0, OBsn1, OBsnfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x ( OBuice,OBuice0,OBuice1,OBuicefile,'u'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x ( OBvice,OBvice0,OBvice1,OBvicefile,'v'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       ENDIF  
 # endif /* ALLOW_SEAICE */  
   
 #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */  
       RETURN  
       END  
 C=========================================================================  
 C=========================================================================  
   
       subroutine obcs_prescribe_exf_yz (  
      I     obcsstartdate, obcsperiod,  
      I     useYearlyFields,  
      U     OBu,   OBu0,   OBu1,   OBufile,  
      U     OBv,   OBv0,   OBv1,   OBvfile,  
      U     OBt,   OBt0,   OBt1,   OBtfile,  
      U     OBs,   OBs0,   OBs1,   OBsfile,  
 #ifdef NONLIN_FRSURF  
      U     OBeta, OBeta0, OBeta1, OBetafile,  
 #endif  
 #ifdef ALLOW_SEAICE  
      I     siobstartdate, siobperiod,  
      U     OBa,   OBa0,   OBa1,   OBafile,  
      U     OBh,   OBh0,   OBh1,   OBhfile,  
      U     OBsl,  OBsl0,  OBsl1,  OBslfile,  
      U     OBsn,  OBsn0,  OBsn1,  OBsnfile,  
      U     OBuice,OBuice0,OBuice1,OBuicefile,  
      U     OBvice,OBvice0,OBvice1,OBvicefile,  
 #endif  
 #ifdef ALLOW_PTRACERS  
      U     OBptr ,OBptr0, OBptr1, OBptrFile,  
 #endif  
      I     mycurrenttime, mycurrentiter, mythid  
      &     )  
 c     |==================================================================|  
 c     | SUBROUTINE obcs_prescribe_exf_yz                                 |  
 c     |==================================================================|  
 c     | read open boundary conditions from file                          |  
 c     | N.B.: * uses exf and cal routines for file/record handling       |  
 c     |       * uses ctrl routines for control variable handling         |  
 c     |==================================================================|  
   
       implicit none  
   
 c     == global variables ==  
   
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #include "PARAMS.h"  
 #ifdef ALLOW_EXF  
 # include "EXF_PARAM.h"  
 #endif  
 #ifdef ALLOW_PTRACERS  
 # include "PTRACERS_SIZE.h"  
 # include "PTRACERS_PARAMS.h"  
 #endif /* ALLOW_PTRACERS */  
   
 c     == routine arguments ==  
   
       _RL     obcsstartdate  
       _RL     obcsperiod  
       LOGICAL useYearlyFields  
       _RL OBu     (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBv     (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBt     (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBs     (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBu0    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBv0    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBt0    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBs0    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBu1    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBv1    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBt1    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       _RL OBs1    (1-Oly:sNy+Oly,Nr,nSx,nSy)  
       CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile  
 #ifdef NONLIN_FRSURF  
       _RL OBeta   (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBeta0  (1-Olx:sNx+Olx,nSx,nSy)  
       _RL OBeta1  (1-Olx:sNx+Olx,nSx,nSy)  
       CHARACTER*(MAX_LEN_FNAM) OBetaFile  
 #endif  
 #ifdef ALLOW_SEAICE  
       _RL     siobstartdate  
       _RL     siobperiod  
       _RL OBa     (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBh     (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBa0    (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBh0    (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBa1    (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBh1    (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBsl    (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBsn    (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBsl0   (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBsn0   (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBsl1   (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBsn1   (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBuice  (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBvice  (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBuice0 (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBvice0 (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBuice1 (1-Oly:sNy+Oly,nSx,nSy)  
       _RL OBvice1 (1-Oly:sNy+Oly,nSx,nSy)  
       CHARACTER*(MAX_LEN_FNAM)  
      &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile  
 #endif /* ALLOW_SEAICE */  
 #ifdef ALLOW_PTRACERS  
       _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)  
       _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)  
       _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)  
       CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)  
 #endif /* ALLOW_PTRACERS */  
       _RL     mycurrenttime  
       integer mycurrentiter  
       integer mythid  
   
 #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \  
     && defined ALLOW_EXF  
   
 c     == local variables ==  
       logical first, changed  
       integer count0, count1  
       integer year0, year1  
       _RL     fac  
 # ifdef ALLOW_PTRACERS  
       integer iTracer  
 # endif /* ALLOW_PTRACERS */  
   
 c     == end of interface ==  
       if ( obcsperiod .eq. -12. _d 0 ) then  
 c     obcsperiod=-12 means input file contains 12 monthly means  
 c     record numbers are assumed 1 to 12 corresponding to  
 c     Jan. through Dec.  
        call cal_GetMonthsRec(  
      O                        fac, first, changed,  
      O                        count0, count1,  
      I                        mycurrenttime, mycurrentiter, mythid  
      &           )  
   
       elseif ( obcsperiod .lt. 0. _d 0 ) then  
        print *, 'obcsperiod is out of range'  
        STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'  
       else  
 c     get record numbers and interpolation factor  
        call exf_GetFFieldRec(  
      I                       obcsstartdate, obcsperiod,  
      I                       useYearlyFields,  
      O                       fac, first, changed,  
      O                       count0, count1, year0, year1,  
      I                       mycurrenttime, mycurrentiter, mythid  
      &                      )  
       endif  
       call exf_set_obcs_yz(  OBu, OBu0, OBu1, OBufile, 'u'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBv, OBv0, OBv1, OBvfile, 'v'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBt, OBt0, OBt1, OBtfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBs, OBs0, OBs1, OBsfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
 # ifdef NONLIN_FRSURF  
        call exf_set_obcs_y ( OBeta, OBeta0, OBeta1, OBetaFile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , obcsperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
 # endif /* NONLIN_FRSURF */  
 # ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do iTracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_yz(  OBptr (1-Olx,1,1,1,iTracer)  
      I                       , OBptr0(1-Olx,1,1,1,iTracer)  
      I                       , OBptr1(1-Olx,1,1,1,iTracer)  
      I                       , OBptrFile(iTracer), 's'  
      I                       , fac, first, changed, useYearlyFields  
      I                       , obcsperiod, count0, count1, year0, year1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 # endif /* ALLOW_PTRACERS */  
 # ifdef ALLOW_SEAICE  
       IF (useSEAICE) THEN  
        if ( siobperiod .eq. -12. _d 0 ) then  
 c     siobperiod=-12 means input file contains 12 monthly means  
 c     record numbers are assumed 1 to 12 corresponding to  
 c     Jan. through Dec.  
         call cal_GetMonthsRec(  
      O                        fac, first, changed,  
      O                        count0, count1,  
      I                        mycurrenttime, mycurrentiter, mythid  
      &           )  
   
        elseif ( siobperiod .lt. 0. _d 0 ) then  
         print *, 'siobperiod is out of range'  
         STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'  
        else  
 c     get record numbers and interpolation factor  
         call exf_GetFFieldRec(  
      I                       siobstartdate, siobperiod,  
      I                       useYearlyFields,  
      O                       fac, first, changed,  
      O                       count0, count1, year0, year1,  
      I                       mycurrenttime, mycurrentiter, mythid  
      &                      )  
        endif  
        call exf_set_obcs_y (  OBa, OBa0, OBa1, OBafile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y (  OBh, OBh0, OBh1, OBhfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y (  OBsl, OBsl0, OBsl1, OBslfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y (  OBsn, OBsn0, OBsn1, OBsnfile, 's'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'u'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'v'  
      I                     , fac, first, changed, useYearlyFields  
      I                     , siobperiod, count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       ENDIF  
 # endif /* ALLOW_SEAICE */  
82    
 #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */  
83        RETURN        RETURN
84        END        END

Legend:
Removed from v.1.28  
changed lines
  Added in v.1.29

  ViewVC Help
Powered by ViewVC 1.1.22