hs94.1x64x5/code_oad/ctrl_map_ini_genarr.F

e9a88bebd8 Patr*0001 #include "CTRL_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: CTRL_MAP_INI_GENARR
                0005 C     !INTERFACE:
                0006       SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *=================================================================
                0010 C     | SUBROUTINE CTRL_MAP_INI_GENARR
                0011 C     | Add the generic arrays of the
                0012 C     | control vector to the model state and update the tile halos.
4d72283393 Mart*0013 C     | The control vector is defined in the header file "CTRL.h".
e9a88bebd8 Patr*0014 C     *=================================================================
2e7aec9951 dngo*0015 C     | local version for OpenAD exp. hs94.1x64x5
                0016 C     *=================================================================
e9a88bebd8 Patr*0017 C     \ev
                0018
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021
                0022 C     == global variables ==
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "GRID.h"
                0027 #include "DYNVARS.h"
                0028 #include "FFIELDS.h"
                0029 #include "CTRL_SIZE.h"
4d72283393 Mart*0030 #include "CTRL.h"
e9a88bebd8 Patr*0031 #include "CTRL_GENARR.h"
edcd27be69 Mart*0032 #include "CTRL_DUMMY.h"
65754df434 Mart*0033 #include "OPTIMCYCLE.h"
e9a88bebd8 Patr*0034 #ifdef ALLOW_PTRACERS
                0035 # include "PTRACERS_SIZE.h"
                0036 c#include "PTRACERS_PARAMS.h"
                0037 # include "PTRACERS_FIELDS.h"
                0038 #endif
                0039
                0040 C     !INPUT/OUTPUT PARAMETERS:
                0041 C     == routine arguments ==
                0042       INTEGER myThid
                0043
                0044 C     !FUNCTIONS:
                0045       INTEGER  ILNBLNk
                0046       EXTERNAL ILNBLNK
                0047
                0048 C     !LOCAL VARIABLES:
                0049 C     == local variables ==
2e7aec9951 dngo*0050       INTEGER bi,bj
                0051       INTEGER i,j,k
                0052       INTEGER jmin,jmax
                0053       INTEGER imin,imax
                0054       INTEGER il
                0055       INTEGER iarr
                0056
                0057       LOGICAL doglobalread
                0058       LOGICAL ladinit
de57a2ec4b Mart*0059       CHARACTER*(MAX_LEN_FNAM) fnamebase
                0060       CHARACTER*(MAX_LEN_FNAM) fnamegeneric
e9a88bebd8 Patr*0061       _RL     fac
7c50f07931 Mart*0062 #ifdef ALLOW_GENARR2D_CONTROL
2e7aec9951 dngo*0063       _RL     tmpfld2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,   nSx,nSy)
7c50f07931 Mart*0064 #endif
                0065 #ifdef ALLOW_GENARR3D_CONTROL
2e7aec9951 dngo*0066       _RL     tmpfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
7c50f07931 Mart*0067 #endif
e9a88bebd8 Patr*0068 CEOP
                0069
                0070       jmin = 1
                0071       jmax = sNy
                0072       imin = 1
                0073       imax = sNx
                0074
2e7aec9951 dngo*0075       doglobalread = .FALSE.
                0076       ladinit      = .FALSE.
e9a88bebd8 Patr*0077       fac = 1. _d 0
                0078
                0079 #ifdef ALLOW_GENARR2D_CONTROL
                0080 C--   An example of connecting specific fields
                0081 C--   to 3 generic 2D control arrays
                0082 cc--->>>
                0083 cc--->>> COMPILE FAILURE IS DELIBERATE
                0084 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0085 cc--->>>
                0086 C--   generic - user-defined control vars
                0087       DO iarr = 1, maxCtrlArr2D
                0088
                0089        fnamebase = xx_genarr2d_file(iarr)
                0090        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0091        WRITE(fnamegeneric,'(2A,I10.10)')
e9a88bebd8 Patr*0092      &     fnamebase(1:il),'.',optimcycle
                0093        CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
                0094      &                      doglobalread, ladinit, optimcycle,
                0095      &                      myThid, xx_genarr2d_dummy(iarr) )
                0096        DO bj=myByLo(myThid), myByHi(myThid)
                0097         DO bi=myBxLo(myThid), myBxHi(myThid)
2e7aec9951 dngo*0098           DO j = jmin,jmax
                0099             DO i = imin,imax
                0100               IF ( iarr .EQ. 1 ) THEN
e9a88bebd8 Patr*0101                 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
                0102      &                             + tmpfld2d(i,j,bi,bj)
2e7aec9951 dngo*0103               ELSEIF ( iarr .EQ. 2 ) THEN
e9a88bebd8 Patr*0104                 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
                0105      &                            + tmpfld2d(i,j,bi,bj)
2e7aec9951 dngo*0106               ENDIF
                0107             ENDDO
                0108           ENDDO
e9a88bebd8 Patr*0109         ENDDO
                0110        ENDDO
                0111 C--   end iarr loop
                0112       ENDDO
57b21c88e4 Patr*0113
e9a88bebd8 Patr*0114        _EXCH_XYZ_RL( theta, myThid )
                0115        _EXCH_XYZ_RL( salt, myThid )
                0116
                0117 #endif /* ALLOW_GENARR2D_CONTROL */
                0118
                0119 #ifdef ALLOW_GENARR3D_CONTROL
                0120 C--   An example of connecting specific fields
                0121 C--   to 3 generic 3D control arrays
                0122 cc--->>>
                0123 cc--->>> COMPILE FAILURE IS DELIBERATE
                0124 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
                0125 cc--->>>
                0126 C--   generic - user-defined control vars
                0127       DO iarr = 1, maxCtrlArr3D
                0128
                0129        fnamebase = xx_genarr3d_file(iarr)
                0130        il=ILNBLNK( fnamebase )
de57a2ec4b Mart*0131        WRITE(fnamegeneric,'(2A,I10.10)')
e9a88bebd8 Patr*0132      &     fnamebase(1:il),'.',optimcycle
                0133        CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
                0134      &                       doglobalread, ladinit, optimcycle,
                0135      &                       myThid, xx_genarr3d_dummy(iarr) )
                0136        DO bj=myByLo(myThid), myByHi(myThid)
                0137         DO bi=myBxLo(myThid), myBxHi(myThid)
2e7aec9951 dngo*0138           DO k = 1,Nr
                0139            DO j = jmin,jmax
                0140             DO i = imin,imax
                0141 cc              if ( iarr .EQ. 1 ) then
57b21c88e4 Patr*0142 cc                theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
                0143 cc     &                             + fac*tmpfld3d(i,j,k,bi,bj)
2e7aec9951 dngo*0144 cc              ELSEIF ( iarr .EQ. 2 ) then
57b21c88e4 Patr*0145 cc                salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
                0146 cc     &                            + fac*tmpfld3d(i,j,k,bi,bj)
                0147 cc              endif
2e7aec9951 dngo*0148             ENDDO
                0149            ENDDO
                0150           ENDDO
e9a88bebd8 Patr*0151         ENDDO
                0152        ENDDO
                0153 C--   end iarr loop
                0154       ENDDO
57b21c88e4 Patr*0155
                0156 cc       _EXCH_XYZ_RL( theta, myThid )
                0157 cc       _EXCH_XYZ_RL( salt, myThid )
e9a88bebd8 Patr*0158
                0159 #endif /* ALLOW_GENARR3D_CONTROL */
                0160
                0161       RETURN
                0162       END