/[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.4 by jmc, Sun Aug 12 19:59:03 2012 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*( 80)   fnamegeneric        character*( 80)   fnamegeneric
   
61        _RL     fac        _RL     fac
       _RL tmptest  
   
 c     == external ==  
       integer  ilnblnk  
       external ilnblnk  
   
 c     == end of interface ==  
62  CEOP  CEOP
63    
       jtlo = mybylo(mythid)  
       jthi = mybyhi(mythid)  
       itlo = mybxlo(mythid)  
       ithi = mybxhi(mythid)  
64        jmin = 1        jmin = 1
65        jmax = sny        jmax = sNy
66        imin = 1        imin = 1
67        imax = snx        imax = sNx
68    
69        doglobalread = .false.        doglobalread = .false.
70        ladinit      = .false.        ladinit      = .false.
71          fac = 1. _d 0
       equal = .true.  
   
       if ( equal ) then  
         fac = 1. _d 0  
       else  
         fac = 0. _d 0  
       endif  
72    
73  #ifdef ALLOW_GENARR2D_CONTROL  #ifdef ALLOW_GENARR2D_CONTROL
74  c--   An example of connecting specific fields  C--   An example of connecting specific fields
75  c--   to 3 generic 2D control arrays  C--   to 3 generic 2D control arrays
76  cc--->>>  cc--->>>
77  cc--->>> COMPILE FAILURE IS DELIBERATE  cc--->>> COMPILE FAILURE IS DELIBERATE
78  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
79  cc--->>>  cc--->>>
80  c--   generic - user-defined control vars  C--   generic - user-defined control vars
81        do iarr = 1, maxCtrlArr2D        DO iarr = 1, maxCtrlArr2D
82         il=ilnblnk( xx_genarr2d_file(iarr) )  
83           il=ILNBLNK( xx_genarr2d_file(iarr) )
84         write(fnamegeneric(1:80),'(2a,i10.10)')         write(fnamegeneric(1:80),'(2a,i10.10)')
85       &     xx_genarr2d_file(iarr)(1:il),'.',optimcycle       &     xx_genarr2d_file(iarr)(1:il),'.',optimcycle
86         call active_read_xy ( fnamegeneric, tmpfld2d, 1,         CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
87       &                      doglobalread, ladinit, optimcycle,       &                      doglobalread, ladinit, optimcycle,
88       &                      mythid, xx_genarr2d_dummy(iarr) )       &                      myThid, xx_genarr2d_dummy(iarr) )
89         do bj = jtlo,jthi         DO bj=myByLo(myThid), myByHi(myThid)
90           do bi = itlo,ithi          DO bi=myBxLo(myThid), myBxHi(myThid)
91             do j = jmin,jmax            do j = jmin,jmax
92               do i = imin,imax              do i = imin,imax
93                if ( iarr .eq. 1 ) then                if ( iarr .eq. 1 ) then
94    #ifdef ALLOW_BOTTOMDRAG_CONTROL
95                  bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)                  bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
96       &                                    + tmpfld2d(i,j,bi,bj)       &                                   + tmpfld2d(i,j,bi,bj)
97    #endif
98                elseif ( iarr. eq. 2 ) then                elseif ( iarr. eq. 2 ) then
99                  theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)                  theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
100       &                               + tmpfld2d(i,j,bi,bj)       &                             + tmpfld2d(i,j,bi,bj)
101                elseif ( iarr .eq. 3 ) then                elseif ( iarr .eq. 3 ) then
102                  salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)                  salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
103       &                              + tmpfld2d(i,j,bi,bj)       &                            + tmpfld2d(i,j,bi,bj)
104                endif                endif
105               enddo              enddo
106             enddo            enddo
107           enddo          ENDDO
108         enddo         ENDDO
109  c--  C--   end iarr loop
110         _EXCH_XY_RL( bottomdragfld, mythid )        ENDDO
111         _EXCH_XYZ_RL( theta, mythid )  #ifdef ALLOW_BOTTOMDRAG_CONTROL
112         _EXCH_XYZ_RL( salt, mythid )         _EXCH_XY_RL( bottomdragfld, myThid )
 c--  
       enddo  
113  #endif  #endif
114           _EXCH_XYZ_RL( theta, myThid )
115           _EXCH_XYZ_RL( salt, myThid )
116    
117    #endif /* ALLOW_GENARR2D_CONTROL */
118    
119  #ifdef ALLOW_GENARR3D_CONTROL  #ifdef ALLOW_GENARR3D_CONTROL
120  c--   An example of connecting specific fields  C--   An example of connecting specific fields
121  c--   to 3 generic 3D control arrays  C--   to 3 generic 3D control arrays
122  cc--->>>  cc--->>>
123  cc--->>> COMPILE FAILURE IS DELIBERATE  cc--->>> COMPILE FAILURE IS DELIBERATE
124  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---  cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
125  cc--->>>  cc--->>>
126  c--   generic - user-defined control vars  C--   generic - user-defined control vars
127        do iarr = 1, maxCtrlArr3D        DO iarr = 1, maxCtrlArr3D
128         il=ilnblnk( xx_genarr3d_file(iarr) )  
129           il=ILNBLNK( xx_genarr3d_file(iarr) )
130         write(fnamegeneric(1:80),'(2a,i10.10)')         write(fnamegeneric(1:80),'(2a,i10.10)')
131       &     xx_genarr3d_file(iarr)(1:il),'.',optimcycle       &     xx_genarr3d_file(iarr)(1:il),'.',optimcycle
132         call active_read_xyz( fnamegeneric, tmpfld3d, 1,         CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
133       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
134       &                       mythid, xx_genarr3d_dummy(iarr) )       &                       myThid, xx_genarr3d_dummy(iarr) )
135         do bj = jtlo,jthi         DO bj=myByLo(myThid), myByHi(myThid)
136          do bi = itlo,ithi          DO bi=myBxLo(myThid), myBxHi(myThid)
137            do k = 1,nr            do k = 1,Nr
138              do j = jmin,jmax             do j = jmin,jmax
139                do i = imin,imax              do i = imin,imax
140                 if ( iarr .eq. 1 ) then                if ( iarr .eq. 1 ) then
141                   theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +                  theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
142       &                                fac*tmpfld3d(i,j,k,bi,bj)       &                             + fac*tmpfld3d(i,j,k,bi,bj)
143                 elseif ( iarr .eq. 2 ) then                elseif ( iarr .eq. 2 ) then
144                   salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +                  salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
145       &                               fac*tmpfld3d(i,j,k,bi,bj)       &                            + fac*tmpfld3d(i,j,k,bi,bj)
146                 endif                endif
               enddo  
147              enddo              enddo
148               enddo
149            enddo            enddo
150          enddo          ENDDO
151         enddo         ENDDO
152         _EXCH_XYZ_RL( theta, mythid )  C--   end iarr loop
153         _EXCH_XYZ_RL( salt, mythid )        ENDDO
154         _EXCH_XYZ_RL( diffkr, mythid )         _EXCH_XYZ_RL( theta, myThid )
155  c--         _EXCH_XYZ_RL( salt, myThid )
156        enddo  
157  #endif  #endif /* ALLOW_GENARR3D_CONTROL */
158    
159        return        RETURN
160        end        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22