pkg/openad/the_model_main.F

5dddee4ea2 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
63ef2a2a83 Jean*0003 #include "AD_CONFIG.h"
5a3db3393c Patr*0004 #ifdef ALLOW_OPENAD
                0005 # include "OPENAD_OPTIONS.h"
                0006 #endif
9c28eed2ec Jean*0007 #ifdef ALLOW_AUTODIFF
                0008 # include "AUTODIFF_OPTIONS.h"
                0009 #endif
                0010 #ifdef ALLOW_CTRL
                0011 # include "CTRL_OPTIONS.h"
                0012 #endif
63ef2a2a83 Jean*0013 #ifdef ALLOW_STREAMICE
                0014 # include "STREAMICE_OPTIONS.h"
                0015 #endif
5dddee4ea2 Jean*0016
                0017 CBOP
                0018 C     !ROUTINE: THE_MODEL_MAIN
                0019
                0020 C     !INTERFACE:
                0021       SUBROUTINE THE_MODEL_MAIN(myThid)
                0022
                0023 C     !DESCRIPTION: \bv
                0024 C     *==========================================================*
                0025 C     | SUBROUTINE THE_MODEL_MAIN
acacc28f7f Jean*0026 C     | o This is the OpenAD local version of S/R THE_MODEL_MAIN
                0027 C     |   see ref. version: model/src/the_model_main.F
                0028 C     |   for details about what this routine does.
5dddee4ea2 Jean*0029 C     *==========================================================*
                0030 C     \ev
                0031
                0032 C     !CALLING SEQUENCE:
                0033 C     THE_MODEL_MAIN()
                0034 C       |
                0035 C       |
63ef2a2a83 Jean*0036 C       |--INITIALISE_FIXED
5dddee4ea2 Jean*0037 C       |   o Set model configuration (fixed arrays)
                0038 C       |     Topography, hydrography, timestep, grid, etc..
                0039 C       |
                0040 C       |--CTRL_UNPACK      o Derivative mode. Unpack control vector.
                0041 C       |
                0042 C       |--ADTHE_MAIN_LOOP  o Main timestepping loop for combined
                0043 C       |                     prognostic and reverse mode integration.
                0044 C       |
                0045 C       |--THE_MAIN_LOOP    o Main timestepping loop for pure prognostic
                0046 C       |                     integration.
                0047 C       |
63ef2a2a83 Jean*0048 C       |--CTRL_PACK        o Derivative mode. Unpack control vector.
                0049 C       |
                0050 C       |--GRDCHK_MAIN      o Gradient check control routine.
5dddee4ea2 Jean*0051 C       |
                0052 C       |--TIMER_PRINTALL   o Print out timing statistics.
                0053 C       |
                0054 C       |--COMM_STATS       o Print out communication statistics.
                0055
                0056 C     !USES:
63ef2a2a83 Jean*0057       IMPLICIT NONE
5dddee4ea2 Jean*0058
63ef2a2a83 Jean*0059 C     == Global variables ===
                0060 C -->> OpenAD
5dddee4ea2 Jean*0061       use OAD_active
                0062       use OAD_rev
                0063       use OAD_tape
                0064       use OAD_cp
                0065 #include "cost.h"
63ef2a2a83 Jean*0066 C <<-- OpenAD
5dddee4ea2 Jean*0067 #include "SIZE.h"
                0068 #include "EEPARAMS.h"
                0069 #include "PARAMS.h"
                0070 #include "DYNVARS.h"
5e4cf2f493 Patr*0071 #include "FFIELDS.h"
5dddee4ea2 Jean*0072
                0073 #ifdef ALLOW_CTRL
5cf4364659 Mart*0074 # include "CTRL_SIZE.h"
4d72283393 Mart*0075 # include "CTRL.h"
65754df434 Mart*0076 # include "OPTIMCYCLE.h"
81a1cb3057 Patr*0077 # include "CTRL_GENARR.h"
5dddee4ea2 Jean*0078 #endif
                0079
                0080 C     !INPUT/OUTPUT PARAMETERS:
                0081 C     == Routine arguments ==
63ef2a2a83 Jean*0082 C     myThid :: Thread number for this instance of the routine.
5dddee4ea2 Jean*0083       INTEGER myThid
                0084
4e4ad91a39 Jean*0085 C     !FUNCTIONS:
                0086       INTEGER  ILNBLNK
                0087       EXTERNAL ILNBLNK
                0088
5dddee4ea2 Jean*0089 C     !LOCAL VARIABLES:
                0090 C     == Local variables ==
63ef2a2a83 Jean*0091 C     Note: Under the multi-threaded model myIter and myTime are local
                0092 C           variables passed around as routine arguments.
                0093 C           Although this is fiddly it saves the need to impose
                0094 C           additional synchronisation points when they are updated.
                0095 C     myTime :: Time counter for this thread
                0096 C     myIter :: Iteration counter for this thread
                0097       INTEGER myIter
                0098       _RL     myTime
acacc28f7f Jean*0099       LOGICAL costFinalExist
63ef2a2a83 Jean*0100       LOGICAL lastdiva
                0101 C -->> OpenAD
cda1c18f72 Jean*0102       _RL foo(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
acacc28f7f Jean*0103 c     _RL foo2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5dddee4ea2 Jean*0104       CHARACTER*(10) suff
02068b0da7 Oliv*0105       CHARACTER*(MAX_LEN_FNAM) fname
acacc28f7f Jean*0106       INTEGER il
                0107 c     INTEGER ik
63ef2a2a83 Jean*0108 C <<-- OpenAD
5dddee4ea2 Jean*0109 CEOP
                0110
63ef2a2a83 Jean*0111 C--   set default:
acacc28f7f Jean*0112       costFinalExist = .TRUE.
63ef2a2a83 Jean*0113       lastdiva = .TRUE.
                0114 C -->> OpenAD
                0115 C-    Set the execution mode
5dddee4ea2 Jean*0116       our_rev_mode%arg_store=.FALSE.
                0117       our_rev_mode%arg_restore=.FALSE.
                0118       our_rev_mode%res_store=.FALSE.
                0119       our_rev_mode%res_restore=.FALSE.
                0120       our_rev_mode%plain=.TRUE.
                0121       our_rev_mode%tape=.FALSE.
                0122       our_rev_mode%adjoint=.FALSE.
                0123       our_rev_mode%switchedToCheckpoint=.FALSE.
63ef2a2a83 Jean*0124 C-    Initialize the tape
4e4ad91a39 Jean*0125       CALL OAD_TAPE_INIT()
63ef2a2a83 Jean*0126 C-    Initialize the checkpoint areas
4e4ad91a39 Jean*0127       CALL CP_INIT()
63ef2a2a83 Jean*0128 C <<-- OpenAD
                0129
                0130 #ifdef ALLOW_PETSC
4e4ad91a39 Jean*0131       CALL STREAMICE_INITIALIZE_PETSC
63ef2a2a83 Jean*0132 #endif
5dddee4ea2 Jean*0133
                0134 #ifdef ALLOW_DEBUG
                0135       IF (debugMode) CALL DEBUG_ENTER('THE_MODEL_MAIN',myThid)
                0136 #endif
                0137
                0138 #if defined(USE_PAPI) || defined(USE_PCL_FLOPS_SFP) || defined(USE_PCL_FLOPS) || defined(USE_PCL)
                0139       CALL TIMER_CONTROL('','INIT','THE_MODEL_MAIN',myThid)
                0140 #endif
                0141 C--   This timer encompasses the whole code
                0142       CALL TIMER_START('ALL                    [THE_MODEL_MAIN]',myThid)
                0143
                0144 #ifdef ALLOW_DEBUG
                0145       IF (debugMode) CALL DEBUG_CALL('INITIALISE_FIXED',myThid)
                0146 #endif
                0147 C--   Set model configuration (fixed arrays)
                0148       CALL TIMER_START('INITIALISE_FIXED       [THE_MODEL_MAIN]',myThid)
63ef2a2a83 Jean*0149 C -->> OpenAD
                0150 c     CALL INITIALISE_FIXED( myThid )
5dddee4ea2 Jean*0151       CALL OpenAD_INITIALISE_FIXED( myThid )
63ef2a2a83 Jean*0152 C <<-- OpenAD
5dddee4ea2 Jean*0153       CALL TIMER_STOP ('INITIALISE_FIXED       [THE_MODEL_MAIN]',myThid)
                0154
63ef2a2a83 Jean*0155       myTime = startTime
                0156       myIter = nIter0
5dddee4ea2 Jean*0157
                0158 #if ( defined (ALLOW_ADMTLM) )
63ef2a2a83 Jean*0159
5dddee4ea2 Jean*0160       STOP 'should never get here; ADMTLM_DSVD calls ADMTLM_DRIVER'
63ef2a2a83 Jean*0161
5dddee4ea2 Jean*0162 #elif ( defined (ALLOW_AUTODIFF))
                0163
37e373688b Mart*0164 # ifdef ALLOW_CTRL
acacc28f7f Jean*0165       IF ( useCTRL ) THEN
                0166 #  ifndef EXCLUDE_CTRL_PACK
                0167         INQUIRE( file='costfinal', exist=costFinalExist )
                0168         IF ( .NOT. costFinalExist ) THEN
                0169           IF ( (optimcycle.NE.0 .OR. .NOT.doinitxx)
                0170      &         .AND. doMainUnpack ) THEN
                0171             CALL TIMER_START('CTRL_UNPACK   [THE_MODEL_MAIN]',myThid)
                0172             CALL CTRL_UNPACK( .TRUE. , myThid )
                0173             CALL TIMER_STOP ('CTRL_UNPACK   [THE_MODEL_MAIN]',myThid)
                0174           ENDIF
                0175         ENDIF
5dddee4ea2 Jean*0176 # endif /* EXCLUDE_CTRL_PACK */
acacc28f7f Jean*0177       ENDIF
48e4487714 Gael*0178 # endif /* ALLOW_CTRL */
5dddee4ea2 Jean*0179
                0180 # ifdef ALLOW_COST
63ef2a2a83 Jean*0181       CALL COST_DEPENDENT_INIT ( myThid )
5dddee4ea2 Jean*0182 # endif
                0183
37e373688b Mart*0184 # if defined( ALLOW_TANGENTLINEAR_RUN )
63ef2a2a83 Jean*0185
                0186 #  ifdef ALLOW_DEBUG
                0187       IF (debugMode) CALL DEBUG_CALL('G_THE_MAIN_LOOP',myThid)
                0188 #  endif
                0189       CALL TIMER_START('G_THE_MAIN_LOOP           [TANGENT RUN]',myThid)
                0190       CALL G_THE_MAIN_LOOP ( myTime, myIter, myThid )
                0191       CALL TIMER_STOP ('G_THE_MAIN_LOOP           [TANGENT RUN]',myThid)
                0192
37e373688b Mart*0193 # elif defined( ALLOW_ADJOINT_RUN )
63ef2a2a83 Jean*0194
5dddee4ea2 Jean*0195 #  ifdef ALLOW_DIVIDED_ADJOINT
acacc28f7f Jean*0196       STOP 'In (OpenAD) THE_MODEL_MAIN: ALLOW_DIVIDED_ADJOINT not coded'
5dddee4ea2 Jean*0197 #  else /* ALLOW_DIVIDED_ADJOINT undef */
9c28eed2ec Jean*0198 #   ifndef ALLOW_OPENAD
                0199 #    ifdef ALLOW_DEBUG
63ef2a2a83 Jean*0200       IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid)
9c28eed2ec Jean*0201 #    endif
63ef2a2a83 Jean*0202       CALL TIMER_START('ADTHE_MAIN_LOOP          [ADJOINT RUN]', myThid)
                0203       CALL ADTHE_MAIN_LOOP ( myThid )
                0204       CALL TIMER_STOP ('ADTHE_MAIN_LOOP          [ADJOINT RUN]', myThid)
9c28eed2ec Jean*0205 #   else /* ALLOW_OPENAD defined */
63ef2a2a83 Jean*0206 C -->> OpenAD
9c28eed2ec Jean*0207 #   ifdef ALLOW_DEBUG
                0208       IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
                0209 #   endif
5dddee4ea2 Jean*0210       CALL TIMER_START('THE_MAIN_LOOP (F)      [THE_MODEL_MAIN]',myThid)
                0211       our_rev_mode%plain=.FALSE.
                0212       our_rev_mode%tape=.TRUE.
4e4ad91a39 Jean*0213       CALL TIMERATIO()
63ef2a2a83 Jean*0214       CALL OpenAD_THE_MAIN_LOOP( myTime, myIter, myThid )
5dddee4ea2 Jean*0215       CALL TIMER_STOP ('THE_MAIN_LOOP (F)      [THE_MODEL_MAIN]',myThid)
                0216       CALL TIMER_START('THE_MAIN_LOOP (A)      [THE_MODEL_MAIN]',myThid)
                0217       our_rev_mode%arg_store=.FALSE.
                0218       our_rev_mode%arg_restore=.FALSE.
                0219       our_rev_mode%plain=.FALSE.
                0220       our_rev_mode%tape=.FALSE.
                0221       our_rev_mode%adjoint=.TRUE.
f586d0a2c2 Oliv*0222       IF (myProcID .EQ. 0) THEN
                0223         fc%d=1.0
                0224       ENDIF
4e4ad91a39 Jean*0225       CALL TIMERATIO()
63ef2a2a83 Jean*0226       CALL OpenAD_THE_MAIN_LOOP( myTime, myIter, myThid )
4e4ad91a39 Jean*0227       CALL TIMERATIO()
5dddee4ea2 Jean*0228       our_rev_mode%arg_store=.FALSE.
                0229       our_rev_mode%arg_restore=.FALSE.
                0230       our_rev_mode%plain=.TRUE.
                0231       our_rev_mode%tape=.FALSE.
                0232       our_rev_mode%adjoint=.FALSE.
5e4cf2f493 Patr*0233       WRITE(suff,'(I10.10)') optimcycle
6f5d7c9095 Patr*0234 #   ifndef ALLOW_OPENAD_ACTIVE_READ_XYZ
9c28eed2ec Jean*0235 #   ifdef ALLOW_DIFFKR_CONTROL
5e4cf2f493 Patr*0236       foo=diffkr%d
4e4ad91a39 Jean*0237       il=ILNBLNK( xx_diffkr_file )
acacc28f7f Jean*0238       write(fname,'(4a)') 'ad', xx_diffkr_file(1:il), '.', suff
                0239       CALL WRITE_REC_3D_RL(fname,ctrlprec,Nr,foo,1,myIter,myThid)
9c28eed2ec Jean*0240 #   endif
6f5d7c9095 Patr*0241 #   endif /* ALLOW_OPENAD_ACTIVE_READ_XYZ */
                0242
57b21c88e4 Patr*0243 cc#   ifdef ALLOW_GENARR2D_CONTROL
                0244 cc      do ik = 1, maxCtrlArr2D
                0245 cc        foo2d=xx_genarr2d(:,:,:,:,ik)%d
                0246 cc        write(fname,'(A,I2.2,A)') 'adxx_genarr2d_',ik,'.'
                0247 cc        call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
                0248 cc      enddo
                0249 cc#   endif
                0250 cc#   ifdef ALLOW_GENTIM2D_CONTROL
                0251 cc      do ik = 1, maxCtrlTim2D
                0252 cc        foo2d=xx_gentim2d(:,:,:,:,ik)%d
                0253 cc        write(fname,'(A,I2.2,A)') 'adxx_gentim2d_',ik,'.'
                0254 cc        call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
                0255 cc      enddo
                0256 cc#   endif
                0257 cc#   ifdef ALLOW_GENARR3D_CONTROL
                0258 cc      do ik = 1, maxCtrlArr3D
                0259 cc        foo=xx_genarr3d(:,:,:,:,:,ik)%d
                0260 cc        write(fname,'(A,I2.2,A)') 'adxx_genarr3d_',ik,'.'
                0261 cc        call write_fld_xyz_rl(fname,suff,foo,myIter,1)
                0262 cc      enddo
                0263 cc#   endif
5dddee4ea2 Jean*0264       our_rev_mode%plain=.TRUE.
                0265       our_rev_mode%tape=.FALSE.
                0266       our_rev_mode%adjoint=.FALSE.
                0267       CALL TIMER_STOP ('THE_MAIN_LOOP (A)      [THE_MODEL_MAIN]',myThid)
9c28eed2ec Jean*0268
63ef2a2a83 Jean*0269 C <<-- OpenAD
9c28eed2ec Jean*0270 #   endif /* ALLOW_OPENAD */
                0271 #  endif /* ALLOW_DIVIDED_ADJOINT */
                0272
                0273 # else /* forward run only within AD setting */
                0274
                0275 #  ifdef ALLOW_DEBUG
                0276       IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
                0277 #  endif
                0278 C--   Call time stepping loop of full model
                0279       CALL TIMER_START('THE_MAIN_LOOP          [THE_MODEL_MAIN]',myThid)
                0280       CALL THE_MAIN_LOOP( myTime, myIter, myThid )
                0281       CALL TIMER_STOP ('THE_MAIN_LOOP          [THE_MODEL_MAIN]',myThid)
5dddee4ea2 Jean*0282
63ef2a2a83 Jean*0283 # endif /* forward run only within AD setting */
5dddee4ea2 Jean*0284
37e373688b Mart*0285 # ifdef ALLOW_CTRL
5dddee4ea2 Jean*0286 # ifndef EXCLUDE_CTRL_PACK
ed672a977d Patr*0287 #  ifdef ALLOW_OPENAD
                0288 cph-- ad hoc fix for OpenAD time stepping counter lagging one step
                0289 cph-- after final adjoint step
                0290       myIter=nIter0
                0291 #  endif
acacc28f7f Jean*0292       IF ( useCTRL .AND. lastdiva .AND. doMainPack ) THEN
                0293         CALL TIMER_START('CTRL_PACK           [THE_MODEL_MAIN]',myThid)
                0294         CALL CTRL_PACK( .FALSE. , myThid )
                0295         CALL TIMER_STOP ('CTRL_PACK           [THE_MODEL_MAIN]',myThid)
                0296         IF ( ( optimcycle.EQ.0 .OR. (.NOT. doMainUnpack) )
                0297      &       .AND. myIter.EQ.nIter0 ) THEN
                0298           CALL TIMER_START('CTRL_PACK     [THE_MODEL_MAIN]',myThid)
                0299           CALL CTRL_PACK( .TRUE. , myThid )
                0300           CALL TIMER_STOP ('CTRL_PACK     [THE_MODEL_MAIN]',myThid)
                0301         ENDIF
48e4487714 Gael*0302       ENDIF
5dddee4ea2 Jean*0303 # endif /* EXCLUDE_CTRL_PACK */
48e4487714 Gael*0304 # endif /* ALLOW_CTRL */
5dddee4ea2 Jean*0305
                0306 # ifdef ALLOW_GRDCHK
                0307       IF ( useGrdchk .AND. lastdiva ) THEN
acacc28f7f Jean*0308         CALL TIMER_START('GRDCHK_MAIN         [THE_MODEL_MAIN]',myThid)
                0309         CALL GRDCHK_MAIN( myThid )
                0310         CALL TIMER_STOP ('GRDCHK_MAIN         [THE_MODEL_MAIN]',myThid)
5dddee4ea2 Jean*0311       ENDIF
                0312 # endif
                0313
                0314 #else /* ALL AD-related undef */
                0315
63ef2a2a83 Jean*0316 # ifdef ALLOW_DEBUG
5dddee4ea2 Jean*0317       IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
63ef2a2a83 Jean*0318 # endif
5dddee4ea2 Jean*0319 C--   Call time stepping loop of full model
                0320       CALL TIMER_START('THE_MAIN_LOOP          [THE_MODEL_MAIN]',myThid)
63ef2a2a83 Jean*0321       CALL THE_MAIN_LOOP( myTime, myIter, myThid )
5dddee4ea2 Jean*0322       CALL TIMER_STOP ('THE_MAIN_LOOP          [THE_MODEL_MAIN]',myThid)
                0323
                0324 #endif /* ALLOW_TANGENTLINEAR_RUN ALLOW_ADJOINT_RUN ALLOW_ADMTLM */
                0325
63ef2a2a83 Jean*0326 #ifdef ALLOW_PETSC
4e4ad91a39 Jean*0327       CALL STREAMICE_FINALIZE_PETSC
5dddee4ea2 Jean*0328 #endif
                0329
                0330 #ifdef ALLOW_MNC
                0331       IF (useMNC) THEN
                0332 C       Close all open NetCDF files
63ef2a2a83 Jean*0333         _BEGIN_MASTER( myThid )
5dddee4ea2 Jean*0334         CALL MNC_FILE_CLOSE_ALL( myThid )
63ef2a2a83 Jean*0335         _END_MASTER( myThid )
5dddee4ea2 Jean*0336       ENDIF
                0337 #endif
                0338
                0339 C--   This timer encompasses the whole code
                0340       CALL TIMER_STOP ('ALL                    [THE_MODEL_MAIN]',myThid)
                0341
                0342 C--   Write timer statistics
                0343       IF ( myThid .EQ. 1 ) THEN
acacc28f7f Jean*0344         CALL TIMER_PRINTALL( myThid )
                0345         CALL COMM_STATS
5dddee4ea2 Jean*0346       ENDIF
                0347
                0348 C--   Check threads synchronization :
                0349       CALL BAR_CHECK( 9, myThid )
                0350
                0351 #ifdef ALLOW_DEBUG
                0352       IF (debugMode) CALL DEBUG_LEAVE('THE_MODEL_MAIN',myThid)
                0353 #endif
                0354
                0355       RETURN
                0356       END