/[MITgcm]/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F
ViewVC logotype

Diff of /MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F

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

revision 1.2 by jmc, Wed Aug 1 13:24:38 2012 UTC revision 1.7 by jmc, Sat Apr 5 21:44:33 2014 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_OPTIONS.h"
5    
6  CBOP  CBOP
7  C     !ROUTINE: ctrl_map_ini_genarr  C     !ROUTINE: CTRL_MAP_INI_GENARR
8  C     !INTERFACE:  C     !INTERFACE:
9        subroutine ctrl_map_ini_genarr( mythid )        SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
10    
11  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
12  c     *=================================================================  C     *=================================================================
13  c     | SUBROUTINE ctrl_map_ini_genarr  C     | SUBROUTINE CTRL_MAP_INI_GENARR
14  c     | Add the generic arrays of the  C     | Add the generic arrays of the
15  c     | control vector to the model state and update the tile halos.  C     | control vector to the model state and update the tile halos.
16  c     | The control vector is defined in the header file "ctrl.h".  C     | The control vector is defined in the header file "ctrl.h".
17  c     *=================================================================  C     *=================================================================
18  C     \ev  C     \ev
19    
20  C     !USES:  C     !USES:
21        implicit none        IMPLICIT NONE
22    
23  c     == global variables ==  C     == global variables ==
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26  #include "PARAMS.h"  #include "PARAMS.h"
# Line 39  c#include "PTRACERS_PARAMS.h" Line 39  c#include "PTRACERS_PARAMS.h"
39  #endif  #endif
40    
41  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
42  c     == routine arguments ==  C     == routine arguments ==
43        integer mythid        INTEGER myThid
44    
45  C     !LOCAL VARIABLES:  C     !FUNCTIONS:
46  c     == local variables ==        INTEGER  ILNBLNk
47          EXTERNAL ILNBLNK
48    
49    C     !LOCAL VARIABLES:
50    C     == local variables ==
51        integer bi,bj        integer bi,bj
52        integer i,j,k        integer i,j,k
       integer itlo,ithi  
       integer jtlo,jthi  
53        integer jmin,jmax        integer jmin,jmax
54        integer imin,imax        integer imin,imax
55        integer il        integer il
56        integer iarr        integer iarr
57    
       logical equal  
58        logical doglobalread        logical doglobalread
59        logical ladinit        logical ladinit
60          character*(MAX_LEN_FNAM) fnamebase
61        character*( 80)   fnamegeneric        character*( 80)   fnamegeneric
62          character*(MAX_LEN_MBUF) msgBuf
63        _RL     fac        _RL     fac
       _RL tmptest  
   
 c     == external ==  
       integer  ilnblnk  
       external ilnblnk  
   
 c     == end of interface ==  
64  CEOP  CEOP
65    
       jtlo = mybylo(mythid)  
       jthi = mybyhi(mythid)  
       itlo = mybxlo(mythid)  
       ithi = mybxhi(mythid)  
66        jmin = 1        jmin = 1
67        jmax = sny        jmax = sNy
68        imin = 1        imin = 1
69        imax = snx        imax = sNx
70    
71        doglobalread = .false.        doglobalread = .false.
72        ladinit      = .false.        ladinit      = .false.
73          fac = 1. _d 0
       equal = .true.  
   
       if ( equal ) then  
         fac = 1. _d 0  
       else  
         fac = 0. _d 0  
       endif  
74    
75  #ifdef ALLOW_GENARR2D_CONTROL  #ifdef ALLOW_GENARR2D_CONTROL
76  c--   An example of connecting specific fields  C--   An example of connecting specific fields
77  c--   to 3 generic 2D control arrays  C--   to 3 generic 2D control arrays
78  cc--->>>  cc--->>>
79  cc--->>> COMPILE FAILURE IS DELIBERATE  cc--->>> COMPILE FAILURE IS DELIBERATE
80  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
81  cc--->>>  cc--->>>
82  c--   generic - user-defined control vars  C--   generic - user-defined control vars
83        do iarr = 1, maxCtrlArr2D        DO iarr = 1, maxCtrlArr2D
84         il=ilnblnk( xx_genarr2d_file(iarr) )  
85           fnamebase = xx_genarr2d_file(iarr)
86           il=ILNBLNK( fnamebase )
87         write(fnamegeneric(1:80),'(2a,i10.10)')         write(fnamegeneric(1:80),'(2a,i10.10)')
88       &     xx_genarr2d_file(iarr)(1:il),'.',optimcycle       &     fnamebase(1:il),'.',optimcycle
89         call active_read_xy ( fnamegeneric, tmpfld2d, 1,         CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
90       &                      doglobalread, ladinit, optimcycle,       &                      doglobalread, ladinit, optimcycle,
91       &                      mythid, xx_genarr2d_dummy(iarr) )       &                      myThid, xx_genarr2d_dummy(iarr) )
92         do bj = jtlo,jthi         DO bj=myByLo(myThid), myByHi(myThid)
93           do bi = itlo,ithi          DO bi=myBxLo(myThid), myBxHi(myThid)
94             do j = jmin,jmax            do j = jmin,jmax
95               do i = imin,imax              do i = imin,imax
96    #ifndef ALLOW_OPENAD
97                if ( iarr .eq. 1 ) then                if ( iarr .eq. 1 ) then
98    # ifdef ALLOW_BOTTOMDRAG_CONTROL
99                  bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)                  bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
100       &                                    + tmpfld2d(i,j,bi,bj)       &                                   + tmpfld2d(i,j,bi,bj)
101                elseif ( iarr. eq. 2 ) then  # endif
102                  elseif ( iarr .eq. 2 ) then
103                  theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)                  theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
104       &                               + tmpfld2d(i,j,bi,bj)       &                             + tmpfld2d(i,j,bi,bj)
105                elseif ( iarr .eq. 3 ) then                elseif ( iarr .eq. 3 ) then
106                  salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)                  salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
107       &                              + tmpfld2d(i,j,bi,bj)       &                            + tmpfld2d(i,j,bi,bj)
108                endif                endif
109               enddo  #else
110             enddo                if ( iarr .eq. 1 ) then
111           enddo  # ifdef ALLOW_BOTTOMDRAG_CONTROL
112         enddo                  bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
113  c--       &           + xx_genarr2d(i,j,bi,bj,iarr)
114         _EXCH_XY_RL( bottomdragfld, mythid )       &           + tmpfld2d(i,j,bi,bj)
115         _EXCH_XYZ_RL( theta, mythid )  # endif
116         _EXCH_XYZ_RL( salt, mythid )                elseif ( iarr .eq. 2 ) then
117  c--                  theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
118        enddo       &           + xx_genarr2d(i,j,bi,bj,iarr)
119         &           + tmpfld2d(i,j,bi,bj)
120                  elseif ( iarr .eq. 3 ) then
121                    salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
122         &           + xx_genarr2d(i,j,bi,bj,iarr)
123         &           + tmpfld2d(i,j,bi,bj)
124                  endif
125    #endif /* ALLOW_OPENAD */
126                enddo
127              enddo
128            ENDDO
129           ENDDO
130    C--   end iarr loop
131          ENDDO
132    #ifdef ALLOW_BOTTOMDRAG_CONTROL
133           _EXCH_XY_RL( bottomdragfld, myThid )
134  #endif  #endif
135           _EXCH_XYZ_RL( theta, myThid )
136           _EXCH_XYZ_RL( salt, myThid )
137    
138    #endif /* ALLOW_GENARR2D_CONTROL */
139    
140  #ifdef ALLOW_GENARR3D_CONTROL  #ifdef ALLOW_GENARR3D_CONTROL
141  c--   An example of connecting specific fields  C--   An example of connecting specific fields
142  c--   to 3 generic 3D control arrays  C--   to 3 generic 3D control arrays
143  cc--->>>  cc--->>>
144  cc--->>> COMPILE FAILURE IS DELIBERATE  cc--->>> COMPILE FAILURE IS DELIBERATE
145  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
146  cc--->>>  cc--->>>
147  c--   generic - user-defined control vars  C--   generic - user-defined control vars
148        do iarr = 1, maxCtrlArr3D        DO iarr = 1, maxCtrlArr3D
149         il=ilnblnk( xx_genarr3d_file(iarr) )  
150           fnamebase = xx_genarr3d_file(iarr)
151           il=ILNBLNK( fnamebase )
152         write(fnamegeneric(1:80),'(2a,i10.10)')         write(fnamegeneric(1:80),'(2a,i10.10)')
153       &     xx_genarr3d_file(iarr)(1:il),'.',optimcycle       &     fnamebase(1:il),'.',optimcycle
154         call active_read_xyz( fnamegeneric, tmpfld3d, 1,         CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
155       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
156       &                       mythid, xx_genarr3d_dummy(iarr) )       &                       myThid, xx_genarr3d_dummy(iarr) )
157         do bj = jtlo,jthi         DO bj=myByLo(myThid), myByHi(myThid)
158          do bi = itlo,ithi          DO bi=myBxLo(myThid), myBxHi(myThid)
159            do k = 1,nr            do k = 1,Nr
160              do j = jmin,jmax             do j = jmin,jmax
161                do i = imin,imax              do i = imin,imax
162                 if ( iarr .eq. 1 ) then  #ifndef ALLOW_OPENAD
163                   theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +                if ( iarr .eq. 1 ) then
164       &                                fac*tmpfld3d(i,j,k,bi,bj)                  theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
165                 elseif ( iarr .eq. 2 ) then       &                             + fac*tmpfld3d(i,j,k,bi,bj)
166                   salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +                elseif ( iarr .eq. 2 ) then
167       &                               fac*tmpfld3d(i,j,k,bi,bj)                  salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
168                 endif       &                            + fac*tmpfld3d(i,j,k,bi,bj)
169                enddo                endif
170    #else
171                  if ( iarr .eq. 1 ) then
172                    theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
173         &           + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
174         &           + fac*tmpfld3d(i,j,k,bi,bj)
175                  elseif ( iarr .eq. 2 ) then
176                    salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
177         &           + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
178         &           + fac*tmpfld3d(i,j,k,bi,bj)
179                  endif
180    #endif /* ALLOW_OPENAD */
181              enddo              enddo
182               enddo
183            enddo            enddo
184          enddo          ENDDO
185         enddo         ENDDO
186         _EXCH_XYZ_RL( theta, mythid )  C--   end iarr loop
187         _EXCH_XYZ_RL( salt, mythid )        ENDDO
188         _EXCH_XYZ_RL( diffkr, mythid )         _EXCH_XYZ_RL( theta, myThid )
189  c--         _EXCH_XYZ_RL( salt, myThid )
190        enddo  
191  #endif  #endif /* ALLOW_GENARR3D_CONTROL */
192    
193        return        RETURN
194        end        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22