/[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.9 by mlosch, Wed Mar 22 19:21:58 2006 UTC revision 1.30 by jmc, Tue May 24 14:31:14 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
24    
25  c     == global variables ==  C     == global variables ==
   
 #include "EEPARAMS.h"  
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "GRID.h"  #include "EEPARAMS.h"
28  #include "OBCS.h"  #include "PARAMS.h"
29  #ifdef ALLOW_EXF  
30  # include "exf_param.h"  C     !INPUT/OUTPUT PARAMETERS:
31  #endif  C     myTime :: Simulation time
32  #ifdef ALLOW_PTRACERS.h  C     myIter :: Simulation timestep number
33  # include "PARAMS.h"  C     myThid :: my Thread Id. number
34  # include "PTRACERS_SIZE.h"        _RL     myTime
35  # include "PTRACERS.h"        INTEGER myIter
36  # include "OBCS_PTRACERS.h"        INTEGER myThid
37  #endif /* ALLOW_PTRACERS */  
38    #ifdef ALLOW_OBCS_PRESCRIBE
39  c     == routine arguments ==  
40    C     !LOCAL VARIABLES:
41        _RL     mycurrenttime  CEOP
42        integer mycurrentiter  
43        integer mythid  # ifdef ALLOW_EXF
44          IF ( useEXF ) THEN
45  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_PRESCRIBE))          CALL OBCS_EXF_LOAD( myTime, myIter, myThid )
46          ENDIF
47  c     == local variables ==  # endif /* ALLOW_EXF */
48    
49  #ifdef ALLOW_EXF        IF ( .NOT. useEXF ) THEN
50        logical first, changed  cph#ifndef ALLOW_AUTODIFF_TAMC
51        integer count0, count1         CALL OBCS_FIELDS_LOAD( myTime, myIter, myThid )
52        integer year0, year1  cph#else
53        _RL     fac  cph       STOP 'PH HAS DISABLED THIS RUNTIME OPTION FOR ALLOW_EXF'
54  #ifdef ALLOW_PTRACERS  cph#endif
55        integer iTracer, i,j,k        ENDIF
56  #endif /* ALLOW_PTRACERS */  
57  #endif /* ALLOW_EXF */  # ifdef ALLOW_OBCSN_CONTROL
58          CALL CTRL_GETOBCSN ( myTime, myIter, mythid )
59  c     == end of interface ==  # endif
60    
61  #ifdef ALLOW_EXF  # ifdef ALLOW_OBCSS_CONTROL
62  #ifdef ALLOW_OBCS_NORTH        CALL CTRL_GETOBCSS ( myTime, myIter, mythid )
63        call exf_getffieldrec(  # endif
64       I                       obcsNstartdate, obcsNperiod  
65       I                     , obcsNstartdate1, obcsNstartdate2  # ifdef ALLOW_OBCSW_CONTROL
66       I                     , .false.        CALL CTRL_GETOBCSW ( myTime, myIter, myThid )
67       O                     , fac, first, changed  # endif
68       O                     , count0, count1, year0, year1  
69       I                     , mycurrenttime, mycurrentiter, mythid  # ifdef ALLOW_OBCSE_CONTROL
70       &                     )        CALL CTRL_GETOBCSE ( myTime, myIter, myThid )
71    # endif
       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 )  
 #ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do itracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_xz(  OBNptr (1-Olx,1,1,1,iTracer)  
      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 */  
 #endif  
   
 #ifdef ALLOW_OBCS_SOUTH  
       call exf_getffieldrec(  
      I                       obcsSstartdate, obcsSperiod  
      I                     , obcsSstartdate1, obcsSstartdate2  
      I                     , .false.  
      O                     , fac, first, changed  
      O                     , count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
   
       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 )  
   
 #ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do itracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_xz(  OBSptr (1-Olx,1,1,1,iTracer)  
      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 */  
 #endif  
   
 #ifdef ALLOW_OBCS_EAST  
       call exf_getffieldrec(  
      I                       obcsEstartdate, obcsEperiod  
      I                     , obcsEstartdate1, obcsEstartdate2  
      I                     , .false.  
      O                     , fac, first, changed  
      O                     , count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
   
       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 )  
 #ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do itracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_yz(  OBEptr (1-Oly,1,1,1,iTracer)  
      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 */  
 #endif  
   
 #ifdef ALLOW_OBCS_WEST  
       call exf_getffieldrec(  
      I                       obcsWstartdate, obcsWperiod  
      I                     , obcsWstartdate1, obcsWstartdate2  
      I                     , .false.  
      O                     , fac, first, changed  
      O                     , count0, count1, year0, year1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
   
       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 )  
 #ifdef ALLOW_PTRACERS  
       if ( usePTRACERS ) then  
        do itracer = 1, PTRACERS_numInUse  
         call exf_set_obcs_yz(  OBWptr (1-Oly,1,1,1,iTracer)  
      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 */  
 #endif  
   
 #ifdef ALLOW_OBCS_CONTROL  
 cgg   WARNING: Assuming North Open Boundary exists and has same  
 cgg    calendar information as other boundaries.  
       call ctrl_obcsbal ( mycurrenttime,mycurrentiter,mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSN_CONTROL  
       call ctrl_getobcsn ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSS_CONTROL  
       call ctrl_getobcss ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSW_CONTROL  
       call ctrl_getobcsw ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #ifdef ALLOW_OBCSE_CONTROL  
       call ctrl_getobcse ( mycurrenttime, mycurrentiter, mythid )  
 #endif  
   
 #else /* not ALLOW_EXF */  
       CALL OBCS_EXTERNAL_FIELDS_LOAD(  
      &     myCurrentTime, myCurrentIter, myThid )  
 #endif /*  ALLOw_EXF */  
72    
73  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS_PRESCRIBE */
74    
75        RETURN        RETURN
76        END        END
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.30
  ViewVC Help
Powered by ViewVC 1.1.22