/[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.15 by jmc, Mon Nov 5 19:19:05 2007 UTC revision 1.16 by mlosch, Thu Jan 24 18:39:38 2008 UTC
# Line 23  c     == global variables == Line 23  c     == global variables ==
23  #include "SIZE.h"  #include "SIZE.h"
24  #include "EEPARAMS.h"  #include "EEPARAMS.h"
25  #include "PARAMS.h"  #include "PARAMS.h"
 #include "GRID.h"  
26  #include "OBCS.h"  #include "OBCS.h"
27  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
28  # include "EXF_PARAM.h"  # include "EXF_PARAM.h"
29  #endif  #endif
30  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
31  # include "PTRACERS_SIZE.h"  # include "PTRACERS_SIZE.h"
 # include "PTRACERS_PARAMS.h"  
 # include "PTRACERS_FIELDS.h"  
32  # include "OBCS_PTRACERS.h"  # include "OBCS_PTRACERS.h"
33  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
34    
# Line 45  c     == routine arguments == Line 42  c     == routine arguments ==
42    
43  c     == local variables ==  c     == local variables ==
44    
 #ifdef ALLOW_EXF  
       logical first, changed  
       integer count0, count1  
       integer year0, year1  
       _RL     fac  
 #ifdef ALLOW_PTRACERS  
       integer iTracer, i,j,k  
 #endif /* ALLOW_PTRACERS */  
 #endif /* ALLOW_EXF */  
   
45  c     == end of interface ==  c     == end of interface ==
46    
47  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
48          IF ( useEXF ) THEN
49  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
50        call exf_getffieldrec(        call obcs_prescribe_exf_xz (
51       I                       obcsNstartdate, obcsNperiod       I     obcsNstartdate, obcsNperiod,
52       I                     , obcsNstartdate1, obcsNstartdate2       I     obcsNstartdate1, obcsNstartdate2,
53       I                     , .false.       I     useOBCSYearlyFields,
54       O                     , fac, first, changed       U     OBNu,   OBNu0,   OBNu1,   OBNufile,
55       O                     , count0, count1, year0, year1       U     OBNv,   OBNv0,   OBNv1,   OBNvfile,
56       I                     , mycurrenttime, mycurrentiter, mythid       U     OBNt,   OBNt0,   OBNt1,   OBNtfile,
57       &                     )       U     OBNs,   OBNs0,   OBNs1,   OBNsfile,
   
       call exf_set_obcs_xz(  OBNu, OBNu0, OBNu1, OBNufile, 'u'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBNv, OBNv0, OBNv1, OBNvfile, 'v'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBNt, OBNt0, OBNt1, OBNtfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBNs, OBNs0, OBNs1, OBNsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
58  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
59        IF (useSEAICE) THEN       U     OBNa,   OBNa0,   OBNa1,   OBNafile,
60         call exf_set_obcs_x (  OBNa, OBNa0, OBNa1, OBNafile, 's'       U     OBNh,   OBNh0,   OBNh1,   OBNhfile,
61       I                     , fac, first, changed, count0, count1       U     OBNsl,  OBNsl0,  OBNsl1,  OBNslfile,
62       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBNsn,  OBNsn0,  OBNsn1,  OBNsnfile,
63         call exf_set_obcs_x (  OBNh, OBNh0, OBNh1, OBNhfile, 's'       U     OBNuice,OBNuice0,OBNuice1,OBNuicefile,
64       I                     , fac, first, changed, count0, count1       U     OBNvice,OBNvice0,OBNvice1,OBNvicefile,
65       I                     , mycurrenttime, mycurrentiter, mythid )  #endif
        call exf_set_obcs_x (  OBNsl, OBNsl0, OBNsl1, OBNslfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x (  OBNsn, OBNsn0, OBNsn1, OBNsnfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x ( OBNuice,OBNuice0,OBNuice1,OBNuicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x ( OBNvice,OBNvice0,OBNvice1,OBNvicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       ENDIF  
 #endif /* ALLOW_SEAICE */  
66  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
67        if ( usePTRACERS ) then       U     OBNptr ,OBNptr0, OBNptr1, OBNptrFile,
68         do itracer = 1, PTRACERS_numInUse  #endif
69          call exf_set_obcs_xz(  OBNptr (1-Olx,1,1,1,iTracer)       I     mycurrenttime, mycurrentiter, mythid
70       I                       , OBNptr0(1-Olx,1,1,1,iTracer)       &     )
      I                       , OBNptr1(1-Olx,1,1,1,iTracer)  
      I                       , OBNptrFile(iTracer), 's'  
      I                       , fac, first, changed, count0, count1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 #endif /* ALLOW_PTRACERS */  
71  #endif /* ALLOW_OBCS_NORTH */  #endif /* ALLOW_OBCS_NORTH */
72    
73  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
74        call exf_getffieldrec(        call obcs_prescribe_exf_xz (
75       I                       obcsSstartdate, obcsSperiod       I     obcsSstartdate, obcsSperiod,
76       I                     , obcsSstartdate1, obcsSstartdate2       I     obcsSstartdate1, obcsSstartdate2,
77       I                     , .false.       I     useOBCSYearlyFields,
78       O                     , fac, first, changed       U     OBSu,   OBSu0,   OBSu1,   OBSufile,
79       O                     , count0, count1, year0, year1       U     OBSv,   OBSv0,   OBSv1,   OBSvfile,
80       I                     , mycurrenttime, mycurrentiter, mythid       U     OBSt,   OBSt0,   OBSt1,   OBStfile,
81       &                     )       U     OBSs,   OBSs0,   OBSs1,   OBSsfile,
   
       call exf_set_obcs_xz(  OBSu, OBSu0, OBSu1, OBSufile, 'u'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBSv, OBSv0, OBSv1, OBSvfile, 'v'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBSt, OBSt0, OBSt1, OBStfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_xz(  OBSs, OBSs0, OBSs1, OBSsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
82  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
83        IF (useSEAICE) THEN       U     OBSa,   OBSa0,   OBSa1,   OBSafile,
84         call exf_set_obcs_x (  OBSa, OBSa0, OBSa1, OBSafile, 's'       U     OBSh,   OBSh0,   OBSh1,   OBShfile,
85       I                     , fac, first, changed, count0, count1       U     OBSsl,  OBSsl0,  OBSsl1,  OBSslfile,
86       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBSsn,  OBSsn0,  OBSsn1,  OBSsnfile,
87         call exf_set_obcs_x (  OBSh, OBSh0, OBSh1, OBShfile, 's'       U     OBSuice,OBSuice0,OBSuice1,OBSuicefile,
88       I                     , fac, first, changed, count0, count1       U     OBSvice,OBSvice0,OBSvice1,OBSvicefile,
89       I                     , mycurrenttime, mycurrentiter, mythid )  #endif
        call exf_set_obcs_x (  OBSsl, OBSsl0, OBSsl1, OBSslfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x (  OBSsn, OBSsn0, OBSsn1, OBSsnfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x ( OBSuice,OBSuice0,OBSuice1,OBSuicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_x ( OBSvice,OBSvice0,OBSvice1,OBSvicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       ENDIF  
 #endif /* ALLOW_SEAICE */  
90  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
91        if ( usePTRACERS ) then       U     OBSptr ,OBSptr0, OBSptr1, OBSptrFile,
92         do itracer = 1, PTRACERS_numInUse  #endif
93          call exf_set_obcs_xz(  OBSptr (1-Olx,1,1,1,iTracer)       I     mycurrenttime, mycurrentiter, mythid
94       I                       , OBSptr0(1-Olx,1,1,1,iTracer)       &     )
      I                       , OBSptr1(1-Olx,1,1,1,iTracer)  
      I                       , OBSptrFile(iTracer), 's'  
      I                       , fac, first, changed, count0, count1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 #endif /* ALLOW_PTRACERS */  
95  #endif /* ALLOW_OBCS_SOUTH */  #endif /* ALLOW_OBCS_SOUTH */
96    
97  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
98        call exf_getffieldrec(        call obcs_prescribe_exf_yz (
99       I                       obcsEstartdate, obcsEperiod       I     obcsEstartdate, obcsEperiod,
100       I                     , obcsEstartdate1, obcsEstartdate2       I     obcsEstartdate1, obcsEstartdate2,
101       I                     , .false.       I     useOBCSYearlyFields,
102       O                     , fac, first, changed       U     OBEu,   OBEu0,   OBEu1,   OBEufile,
103       O                     , count0, count1, year0, year1       U     OBEv,   OBEv0,   OBEv1,   OBEvfile,
104       I                     , mycurrenttime, mycurrentiter, mythid       U     OBEt,   OBEt0,   OBEt1,   OBEtfile,
105       &                     )       U     OBEs,   OBEs0,   OBEs1,   OBEsfile,
   
       call exf_set_obcs_yz(  OBEu, OBEu0, OBEu1, OBEufile, 'u'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBEv, OBEv0, OBEv1, OBEvfile, 'v'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBEt, OBEt0, OBEt1, OBEtfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBEs, OBEs0, OBEs1, OBEsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
106  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
107        IF (useSEAICE) THEN       U     OBEa,   OBEa0,   OBEa1,   OBEafile,
108         call exf_set_obcs_y (  OBEa, OBEa0, OBEa1, OBEafile, 's'       U     OBEh,   OBEh0,   OBEh1,   OBEhfile,
109       I                     , fac, first, changed, count0, count1       U     OBEsl,  OBEsl0,  OBEsl1,  OBEslfile,
110       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBEsn,  OBEsn0,  OBEsn1,  OBEsnfile,
111         call exf_set_obcs_y (  OBEh, OBEh0, OBEh1, OBEhfile, 's'       U     OBEuice,OBEuice0,OBEuice1,OBEuicefile,
112       I                     , fac, first, changed, count0, count1       U     OBEvice,OBEvice0,OBEvice1,OBEvicefile,
113       I                     , mycurrenttime, mycurrentiter, mythid )  #endif
        call exf_set_obcs_y (  OBEsl, OBEsl0, OBEsl1, OBEslfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y (  OBEsn, OBEsn0, OBEsn1, OBEsnfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y ( OBEuice,OBEuice0,OBEuice1,OBEuicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y ( OBEvice,OBEvice0,OBEvice1,OBEvicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       ENDIF  
 #endif /* ALLOW_SEAICE */  
114  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
115        if ( usePTRACERS ) then       U     OBEptr ,OBEptr0, OBEptr1, OBEptrFile,
116         do itracer = 1, PTRACERS_numInUse  #endif
117          call exf_set_obcs_yz(  OBEptr (1-Oly,1,1,1,iTracer)       I     mycurrenttime, mycurrentiter, mythid
118       I                       , OBEptr0(1-Oly,1,1,1,iTracer)       &     )
      I                       , OBEptr1(1-Oly,1,1,1,iTracer)  
      I                       , OBEptrFile(iTracer), 's'  
      I                       , fac, first, changed, count0, count1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 #endif /* ALLOW_PTRACERS */  
119  #endif /* ALLOW_OBCS_EAST */  #endif /* ALLOW_OBCS_EAST */
120    
121  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
122        call exf_getffieldrec(        call obcs_prescribe_exf_yz (
123       I                       obcsWstartdate, obcsWperiod       I     obcsWstartdate, obcsWperiod,
124       I                     , obcsWstartdate1, obcsWstartdate2       I     obcsWstartdate1, obcsWstartdate2,
125       I                     , .false.       I     useOBCSYearlyFields,
126       O                     , fac, first, changed       U     OBWu,   OBWu0,   OBWu1,   OBWufile,
127       O                     , count0, count1, year0, year1       U     OBWv,   OBWv0,   OBWv1,   OBWvfile,
128       I                     , mycurrenttime, mycurrentiter, mythid       U     OBWt,   OBWt0,   OBWt1,   OBWtfile,
129       &                     )       U     OBWs,   OBWs0,   OBWs1,   OBWsfile,
   
       call exf_set_obcs_yz(  OBWu, OBWu0, OBWu1, OBWufile, 'u'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBWv, OBWv0, OBWv1, OBWvfile, 'v'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBWt, OBWt0, OBWt1, OBWtfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       call exf_set_obcs_yz(  OBWs, OBWs0, OBWs1, OBWsfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
130  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
131        IF (useSEAICE) THEN       U     OBWa,   OBWa0,   OBWa1,   OBWafile,
132         call exf_set_obcs_y (  OBWa, OBWa0, OBWa1, OBWafile, 's'       U     OBWh,   OBWh0,   OBWh1,   OBWhfile,
133       I                     , fac, first, changed, count0, count1       U     OBWsl,  OBWsl0,  OBWsl1,  OBWslfile,
134       I                     , mycurrenttime, mycurrentiter, mythid )       U     OBWsn,  OBWsn0,  OBWsn1,  OBWsnfile,
135         call exf_set_obcs_y (  OBWh, OBWh0, OBWh1, OBWhfile, 's'       U     OBWuice,OBWuice0,OBWuice1,OBWuicefile,
136       I                     , fac, first, changed, count0, count1       U     OBWvice,OBWvice0,OBWvice1,OBWvicefile,
137       I                     , mycurrenttime, mycurrentiter, mythid )  #endif
        call exf_set_obcs_y (  OBWsl, OBWsl0, OBWsl1, OBWslfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y (  OBWsn, OBWsn0, OBWsn1, OBWsnfile, 's'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y ( OBWuice,OBWuice0,OBWuice1,OBWuicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
        call exf_set_obcs_y ( OBWvice,OBWvice0,OBWvice1,OBWvicefile,'s'  
      I                     , fac, first, changed, count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid )  
       ENDIF  
 #endif /* ALLOW_SEAICE */  
138  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
139        if ( usePTRACERS ) then       U     OBWptr ,OBWptr0, OBWptr1, OBWptrFile,
140         do itracer = 1, PTRACERS_numInUse  #endif
141          call exf_set_obcs_yz(  OBWptr (1-Oly,1,1,1,iTracer)       I     mycurrenttime, mycurrentiter, mythid
142       I                       , OBWptr0(1-Oly,1,1,1,iTracer)       &     )
      I                       , OBWptr1(1-Oly,1,1,1,iTracer)  
      I                       , OBWptrFile(iTracer), 's'  
      I                       , fac, first, changed, count0, count1  
      I                       , mycurrenttime, mycurrentiter, mythid )  
        enddo  
       endif  
 #endif /* ALLOW_PTRACERS */  
143  #endif /* ALLOW_OBCS_WEST */  #endif /* ALLOW_OBCS_WEST */
144    C     ENDIF useEXF
145          ENDIF
146    #endif /* ALLOW_EXF */
147    
148  #ifdef ALLOW_OBCS_CONTROL  #ifdef ALLOW_OBCS_CONTROL
149  cgg   WARNING: Assuming North Open Boundary exists and has same  cgg   WARNING: Assuming North Open Boundary exists and has same
# Line 312  cgg    calendar information as other bou Line 167  cgg    calendar information as other bou
167        call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )        call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )
168  #endif  #endif
169    
170  #else /* not ALLOW_EXF */        IF ( .NOT. useEXF ) THEN
171        CALL OBCS_EXTERNAL_FIELDS_LOAD(         CALL OBCS_EXTERNAL_FIELDS_LOAD(
172       &     myCurrentTime, myCurrentIter, myThid )       &     myCurrentTime, myCurrentIter, myThid )
173  #endif /*  ALLOw_EXF */        ENDIF
174    
175  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS */
176    
177        RETURN        RETURN
178        END        END
179    
180    C=========================================================================
181    C=========================================================================
182    
183          subroutine obcs_prescribe_exf_xz (
184         I     obcsstartdate, obcsperiod,
185         I     obcsstartdate1, obcsstartdate2,
186         I     useYearlyFields,
187         U     OBu,   OBu0,   OBu1,   OBufile,
188         U     OBv,   OBv0,   OBv1,   OBvfile,
189         U     OBt,   OBt0,   OBt1,   OBtfile,
190         U     OBs,   OBs0,   OBs1,   OBsfile,
191    #if defined ALLOW_SEAICE && defined ALLOW_OBCS
192         U     OBa,   OBa0,   OBa1,   OBafile,
193         U     OBh,   OBh0,   OBh1,   OBhfile,
194         U     OBsl,  OBsl0,  OBsl1,  OBslfile,
195         U     OBsn,  OBsn0,  OBsn1,  OBsnfile,
196         U     OBuice,OBuice0,OBuice1,OBuicefile,
197         U     OBvice,OBvice0,OBvice1,OBvicefile,
198    #endif
199    #if defined ALLOW_PTRACERS && defined ALLOW_OBCS
200         U     OBptr ,OBptr0, OBptr1, OBptrFile,
201    #endif
202         I     mycurrenttime, mycurrentiter, mythid
203         &     )
204    c     |==================================================================|
205    c     | SUBROUTINE obcs_prescribe_exf_xz                                 |
206    c     |==================================================================|
207    c     | read open boundary conditions from file                          |
208    c     | N.B.: * uses exf and cal routines for file/record handling       |
209    c     |       * uses ctrl routines for control variable handling         |
210    c     |==================================================================|
211    
212          implicit none
213    
214    c     == global variables ==
215    
216    #include "SIZE.h"
217    #include "EEPARAMS.h"
218    #include "PARAMS.h"
219    #ifdef ALLOW_EXF
220    # include "EXF_PARAM.h"
221    #endif
222    #ifdef ALLOW_PTRACERS
223    # include "PTRACERS_SIZE.h"
224    # include "PTRACERS_PARAMS.h"
225    #endif /* ALLOW_PTRACERS */
226    
227    c     == routine arguments ==
228    
229          INTEGER obcsstartdate1
230          INTEGER obcsstartdate2
231          _RL     obcsstartdate
232          _RL     obcsperiod
233          LOGICAL useYearlyFields
234          _RL OBu     (1-Olx:sNx+Olx,Nr,nSx,nSy)
235          _RL OBv     (1-Olx:sNx+Olx,Nr,nSx,nSy)
236          _RL OBt     (1-Olx:sNx+Olx,Nr,nSx,nSy)
237          _RL OBs     (1-Olx:sNx+Olx,Nr,nSx,nSy)
238          _RL OBu0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
239          _RL OBv0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
240          _RL OBt0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
241          _RL OBs0    (1-Olx:sNx+Olx,Nr,nSx,nSy)
242          _RL OBu1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
243          _RL OBv1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
244          _RL OBt1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
245          _RL OBs1    (1-Olx:sNx+Olx,Nr,nSx,nSy)
246          CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
247    #if defined ALLOW_SEAICE && defined ALLOW_OBCS
248          _RL OBa     (1-Olx:sNx+Olx,nSx,nSy)
249          _RL OBh     (1-Olx:sNx+Olx,nSx,nSy)
250          _RL OBa0    (1-Olx:sNx+Olx,nSx,nSy)
251          _RL OBh0    (1-Olx:sNx+Olx,nSx,nSy)
252          _RL OBa1    (1-Olx:sNx+Olx,nSx,nSy)
253          _RL OBh1    (1-Olx:sNx+Olx,nSx,nSy)
254          _RL OBsl    (1-Olx:sNx+Olx,nSx,nSy)
255          _RL OBsn    (1-Olx:sNx+Olx,nSx,nSy)
256          _RL OBsl0   (1-Olx:sNx+Olx,nSx,nSy)
257          _RL OBsn0   (1-Olx:sNx+Olx,nSx,nSy)
258          _RL OBsl1   (1-Olx:sNx+Olx,nSx,nSy)
259          _RL OBsn1   (1-Olx:sNx+Olx,nSx,nSy)
260          _RL OBuice  (1-Olx:sNx+Olx,nSx,nSy)
261          _RL OBvice  (1-Olx:sNx+Olx,nSx,nSy)
262          _RL OBuice0 (1-Olx:sNx+Olx,nSx,nSy)
263          _RL OBvice0 (1-Olx:sNx+Olx,nSx,nSy)
264          _RL OBuice1 (1-Olx:sNx+Olx,nSx,nSy)
265          _RL OBvice1 (1-Olx:sNx+Olx,nSx,nSy)
266          CHARACTER*(MAX_LEN_FNAM)
267         &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
268    #endif /* ALLOW_SEAICE */
269    #if defined ALLOW_PTRACERS && defined ALLOW_OBCS
270          _RL OBptr (1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
271          _RL OBptr0(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
272          _RL OBptr1(1-Olx:sNx+Olx,Nr,nSx,nSy,PTRACERS_num)
273          CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
274    #endif /* ALLOW_PTRACERS */
275          _RL     mycurrenttime
276          integer mycurrentiter
277          integer mythid
278    
279    #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
280        && defined ALLOW_EXF
281    
282    c     == local variables ==
283          logical first, changed
284          integer count0, count1
285          integer year0, year1
286          _RL     fac
287    #ifdef ALLOW_PTRACERS
288          integer iTracer, i,j,k
289    #endif /* ALLOW_PTRACERS */
290    
291    c     == end of interface ==
292          if ( obcsperiod .eq. -12 ) then
293    c     obcsperiod=-12 means input file contains 12 monthly means
294    c     record numbers are assumed 1 to 12 corresponding to
295    c     Jan. through Dec.
296           call cal_GetMonthsRec(
297         O                        fac, first, changed,
298         O                        count0, count1,
299         I                        mycurrenttime, mycurrentiter, mythid
300         &           )
301    
302          elseif ( obcsperiod .lt. 0 ) then
303           print *, 'obcsperiod is out of range'
304           STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_XZ'
305          else
306    c     get record numbers and interpolation factor
307           call exf_GetFFieldRec(
308         I                       obcsstartdate, obcsperiod,
309         I                       obcsstartdate1, obcsstartdate2,
310         I                       useYearlyFields,
311         O                       fac, first, changed,
312         O                       count0, count1, year0, year1,
313         I                       mycurrenttime, mycurrentiter, mythid
314         &                      )
315          endif
316    
317          call exf_set_obcs_xz(  OBu, OBu0, OBu1, OBufile, 'u'
318         I                     , fac, first, changed, useYearlyFields
319         I                     , obcsperiod, count0, count1, year0, year1
320         I                     , mycurrenttime, mycurrentiter, mythid )
321          call exf_set_obcs_xz(  OBv, OBv0, OBv1, OBvfile, 'v'
322         I                     , fac, first, changed, useYearlyFields
323         I                     , obcsperiod, count0, count1, year0, year1
324         I                     , mycurrenttime, mycurrentiter, mythid )
325          call exf_set_obcs_xz(  OBt, OBt0, OBt1, OBtfile, 's'
326         I                     , fac, first, changed, useYearlyFields
327         I                     , obcsperiod, count0, count1, year0, year1
328         I                     , mycurrenttime, mycurrentiter, mythid )
329          call exf_set_obcs_xz(  OBs, OBs0, OBs1, OBsfile, 's'
330         I                     , fac, first, changed, useYearlyFields
331         I                     , obcsperiod, count0, count1, year0, year1
332         I                     , mycurrenttime, mycurrentiter, mythid )
333    #ifdef ALLOW_SEAICE
334          IF (useSEAICE) THEN
335           call exf_set_obcs_x (  OBa, OBa0, OBa1, OBafile, 's'
336         I                     , fac, first, changed, useYearlyFields
337         I                     , obcsperiod, count0, count1, year0, year1
338         I                     , mycurrenttime, mycurrentiter, mythid )
339           call exf_set_obcs_x (  OBh, OBh0, OBh1, OBhfile, 's'
340         I                     , fac, first, changed, useYearlyFields
341         I                     , obcsperiod, count0, count1, year0, year1
342         I                     , mycurrenttime, mycurrentiter, mythid )
343           call exf_set_obcs_x (  OBsl, OBsl0, OBsl1, OBslfile, 's'
344         I                     , fac, first, changed, useYearlyFields
345         I                     , obcsperiod, count0, count1, year0, year1
346         I                     , mycurrenttime, mycurrentiter, mythid )
347           call exf_set_obcs_x (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
348         I                     , fac, first, changed, useYearlyFields
349         I                     , obcsperiod, count0, count1, year0, year1
350         I                     , mycurrenttime, mycurrentiter, mythid )
351           call exf_set_obcs_x ( OBuice,OBuice0,OBuice1,OBuicefile,'s'
352         I                     , fac, first, changed, useYearlyFields
353         I                     , obcsperiod, count0, count1, year0, year1
354         I                     , mycurrenttime, mycurrentiter, mythid )
355           call exf_set_obcs_x ( OBvice,OBvice0,OBvice1,OBvicefile,'s'
356         I                     , fac, first, changed, useYearlyFields
357         I                     , obcsperiod, count0, count1, year0, year1
358         I                     , mycurrenttime, mycurrentiter, mythid )
359          ENDIF
360    #endif /* ALLOW_SEAICE */
361    #ifdef ALLOW_PTRACERS
362          if ( usePTRACERS ) then
363           do itracer = 1, PTRACERS_numInUse
364            call exf_set_obcs_xz(  OBptr (1-Olx,1,1,1,iTracer)
365         I                       , OBptr0(1-Olx,1,1,1,iTracer)
366         I                       , OBptr1(1-Olx,1,1,1,iTracer)
367         I                       , OBptrFile(iTracer), 's'
368         I                       , fac, first, changed, useYearlyFields
369         I                       , obcsperiod, count0, count1, year0, year1
370         I                       , mycurrenttime, mycurrentiter, mythid )
371           enddo
372          endif
373    #endif /* ALLOW_PTRACERS */
374    
375    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
376          RETURN
377          END
378    C=========================================================================
379    C=========================================================================
380    
381          subroutine obcs_prescribe_exf_yz (
382         I     obcsstartdate, obcsperiod,
383         I     obcsstartdate1, obcsstartdate2,
384         I     useYearlyFields,
385         U     OBu,   OBu0,   OBu1,   OBufile,
386         U     OBv,   OBv0,   OBv1,   OBvfile,
387         U     OBt,   OBt0,   OBt1,   OBtfile,
388         U     OBs,   OBs0,   OBs1,   OBsfile,
389    #if defined ALLOW_SEAICE && defined ALLOW_OBCS
390         U     OBa,   OBa0,   OBa1,   OBafile,
391         U     OBh,   OBh0,   OBh1,   OBhfile,
392         U     OBsl,  OBsl0,  OBsl1,  OBslfile,
393         U     OBsn,  OBsn0,  OBsn1,  OBsnfile,
394         U     OBuice,OBuice0,OBuice1,OBuicefile,
395         U     OBvice,OBvice0,OBvice1,OBvicefile,
396    #endif
397    #if defined ALLOW_PTRACERS && defined ALLOW_OBCS
398         U     OBptr ,OBptr0, OBptr1, OBptrFile,
399    #endif
400         I     mycurrenttime, mycurrentiter, mythid
401         &     )
402    c     |==================================================================|
403    c     | SUBROUTINE obcs_prescribe_exf_yz                                 |
404    c     |==================================================================|
405    c     | read open boundary conditions from file                          |
406    c     | N.B.: * uses exf and cal routines for file/record handling       |
407    c     |       * uses ctrl routines for control variable handling         |
408    c     |==================================================================|
409    
410          implicit none
411    
412    c     == global variables ==
413    
414    #include "SIZE.h"
415    #include "EEPARAMS.h"
416    #include "PARAMS.h"
417    #ifdef ALLOW_EXF
418    # include "EXF_PARAM.h"
419    #endif
420    #ifdef ALLOW_PTRACERS
421    # include "PTRACERS_SIZE.h"
422    # include "PTRACERS_PARAMS.h"
423    #endif /* ALLOW_PTRACERS */
424    
425    c     == routine arguments ==
426    
427          INTEGER obcsstartdate1
428          INTEGER obcsstartdate2
429          _RL     obcsstartdate
430          _RL     obcsperiod
431          LOGICAL useYearlyFields
432          _RL OBu     (1-Oly:sNy+Oly,Nr,nSx,nSy)
433          _RL OBv     (1-Oly:sNy+Oly,Nr,nSx,nSy)
434          _RL OBt     (1-Oly:sNy+Oly,Nr,nSx,nSy)
435          _RL OBs     (1-Oly:sNy+Oly,Nr,nSx,nSy)
436          _RL OBu0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
437          _RL OBv0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
438          _RL OBt0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
439          _RL OBs0    (1-Oly:sNy+Oly,Nr,nSx,nSy)
440          _RL OBu1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
441          _RL OBv1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
442          _RL OBt1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
443          _RL OBs1    (1-Oly:sNy+Oly,Nr,nSx,nSy)
444          CHARACTER*(MAX_LEN_FNAM) OBuFile,OBvFile,OBtFile,OBsFile
445    #if defined ALLOW_SEAICE && defined ALLOW_OBCS
446          _RL OBa     (1-Oly:sNy+Oly,nSx,nSy)
447          _RL OBh     (1-Oly:sNy+Oly,nSx,nSy)
448          _RL OBa0    (1-Oly:sNy+Oly,nSx,nSy)
449          _RL OBh0    (1-Oly:sNy+Oly,nSx,nSy)
450          _RL OBa1    (1-Oly:sNy+Oly,nSx,nSy)
451          _RL OBh1    (1-Oly:sNy+Oly,nSx,nSy)
452          _RL OBsl    (1-Oly:sNy+Oly,nSx,nSy)
453          _RL OBsn    (1-Oly:sNy+Oly,nSx,nSy)
454          _RL OBsl0   (1-Oly:sNy+Oly,nSx,nSy)
455          _RL OBsn0   (1-Oly:sNy+Oly,nSx,nSy)
456          _RL OBsl1   (1-Oly:sNy+Oly,nSx,nSy)
457          _RL OBsn1   (1-Oly:sNy+Oly,nSx,nSy)
458          _RL OBuice  (1-Oly:sNy+Oly,nSx,nSy)
459          _RL OBvice  (1-Oly:sNy+Oly,nSx,nSy)
460          _RL OBuice0 (1-Oly:sNy+Oly,nSx,nSy)
461          _RL OBvice0 (1-Oly:sNy+Oly,nSx,nSy)
462          _RL OBuice1 (1-Oly:sNy+Oly,nSx,nSy)
463          _RL OBvice1 (1-Oly:sNy+Oly,nSx,nSy)
464          CHARACTER*(MAX_LEN_FNAM)
465         &     OBaFile,OBhFile,OBslFile,OBsnFile,OBuiceFile,OBviceFile
466    #endif /* ALLOW_SEAICE */
467    #if defined ALLOW_PTRACERS && defined ALLOW_OBCS
468          _RL OBptr (1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
469          _RL OBptr0(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
470          _RL OBptr1(1-Oly:sNy+Oly,Nr,nSx,nSy,PTRACERS_num)
471          CHARACTER*(MAX_LEN_FNAM) OBptrFile(PTRACERS_num)
472    #endif /* ALLOW_PTRACERS */
473          _RL     mycurrenttime
474          integer mycurrentiter
475          integer mythid
476    
477    #if defined ALLOW_OBCS && defined ALLOW_OBCS_PRESCRIBE \
478        && defined ALLOW_EXF
479    
480    c     == local variables ==
481          logical first, changed
482          integer count0, count1
483          integer year0, year1
484          _RL     fac
485    #ifdef ALLOW_PTRACERS
486          integer iTracer, i,j,k
487    #endif /* ALLOW_PTRACERS */
488    
489    c     == end of interface ==
490          if ( obcsperiod .eq. -12 ) then
491    c     obcsperiod=-12 means input file contains 12 monthly means
492    c     record numbers are assumed 1 to 12 corresponding to
493    c     Jan. through Dec.
494           call cal_GetMonthsRec(
495         O                        fac, first, changed,
496         O                        count0, count1,
497         I                        mycurrenttime, mycurrentiter, mythid
498         &           )
499    
500          elseif ( obcsperiod .lt. 0 ) then
501           print *, 'obcsperiod is out of range'
502           STOP 'ABNORMAL END: S/R OBCS_PRESCIBE_EXF_YZ'
503          else
504    c     get record numbers and interpolation factor
505           call exf_GetFFieldRec(
506         I                       obcsstartdate, obcsperiod,
507         I                       obcsstartdate1, obcsstartdate2,
508         I                       useYearlyFields,
509         O                       fac, first, changed,
510         O                       count0, count1, year0, year1,
511         I                       mycurrenttime, mycurrentiter, mythid
512         &                      )
513          endif
514    
515          call exf_set_obcs_yz(  OBu, OBu0, OBu1, OBufile, 'u'
516         I                     , fac, first, changed, useYearlyFields
517         I                     , obcsperiod, count0, count1, year0, year1
518         I                     , mycurrenttime, mycurrentiter, mythid )
519          call exf_set_obcs_yz(  OBv, OBv0, OBv1, OBvfile, 'v'
520         I                     , fac, first, changed, useYearlyFields
521         I                     , obcsperiod, count0, count1, year0, year1
522         I                     , mycurrenttime, mycurrentiter, mythid )
523          call exf_set_obcs_yz(  OBt, OBt0, OBt1, OBtfile, 's'
524         I                     , fac, first, changed, useYearlyFields
525         I                     , obcsperiod, count0, count1, year0, year1
526         I                     , mycurrenttime, mycurrentiter, mythid )
527          call exf_set_obcs_yz(  OBs, OBs0, OBs1, OBsfile, 's'
528         I                     , fac, first, changed, useYearlyFields
529         I                     , obcsperiod, count0, count1, year0, year1
530         I                     , mycurrenttime, mycurrentiter, mythid )
531    #ifdef ALLOW_SEAICE
532          IF (useSEAICE) THEN
533           call exf_set_obcs_y (  OBa, OBa0, OBa1, OBafile, 's'
534         I                     , fac, first, changed, useYearlyFields
535         I                     , obcsperiod, count0, count1, year0, year1
536         I                     , mycurrenttime, mycurrentiter, mythid )
537           call exf_set_obcs_y (  OBh, OBh0, OBh1, OBhfile, 's'
538         I                     , fac, first, changed, useYearlyFields
539         I                     , obcsperiod, count0, count1, year0, year1
540         I                     , mycurrenttime, mycurrentiter, mythid )
541           call exf_set_obcs_y (  OBsl, OBsl0, OBsl1, OBslfile, 's'
542         I                     , fac, first, changed, useYearlyFields
543         I                     , obcsperiod, count0, count1, year0, year1
544         I                     , mycurrenttime, mycurrentiter, mythid )
545           call exf_set_obcs_y (  OBsn, OBsn0, OBsn1, OBsnfile, 's'
546         I                     , fac, first, changed, useYearlyFields
547         I                     , obcsperiod, count0, count1, year0, year1
548         I                     , mycurrenttime, mycurrentiter, mythid )
549           call exf_set_obcs_y ( OBuice,OBuice0,OBuice1,OBuicefile,'s'
550         I                     , fac, first, changed, useYearlyFields
551         I                     , obcsperiod, count0, count1, year0, year1
552         I                     , mycurrenttime, mycurrentiter, mythid )
553           call exf_set_obcs_y ( OBvice,OBvice0,OBvice1,OBvicefile,'s'
554         I                     , fac, first, changed, useYearlyFields
555         I                     , obcsperiod, count0, count1, year0, year1
556         I                     , mycurrenttime, mycurrentiter, mythid )
557          ENDIF
558    #endif /* ALLOW_SEAICE */
559    #ifdef ALLOW_PTRACERS
560          if ( usePTRACERS ) then
561           do itracer = 1, PTRACERS_numInUse
562            call exf_set_obcs_yz(  OBptr (1-Olx,1,1,1,iTracer)
563         I                       , OBptr0(1-Olx,1,1,1,iTracer)
564         I                       , OBptr1(1-Olx,1,1,1,iTracer)
565         I                       , OBptrFile(iTracer), 's'
566         I                       , fac, first, changed, useYearlyFields
567         I                       , obcsperiod, count0, count1, year0, year1
568         I                       , mycurrenttime, mycurrentiter, mythid )
569           enddo
570          endif
571    #endif /* ALLOW_PTRACERS */
572    
573    #endif /* ALLOW_OBCS and ALLOW_OBCS_PRESCRIBE and ALLOW_EXF */
574          RETURN
575          END
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22