diff --git a/doc/tag-index b/doc/tag-index index c131d65c0..682652ea0 100644 --- a/doc/tag-index +++ b/doc/tag-index @@ -1,6 +1,13 @@ Notes on tags used in MITgcmUV ============================== +o pkg/diagnostics: + - to allow to use ADJ-diags in DIVA runs, change call sequence regarding + TURNOFF_MODEL_IO and DIAGSTATS_INI_IO and simplify (fewer tests for + "costfinal") the_model_main.F (+ shorten pkg/openad version) ; + - restore the use of "diag_pkgStatus" (switch & check) in AD backward sweep + with new small S/R for DIVA runs ; + - turn on FWD and ADJ-diags in secondary lab_sea AD test "noseaice". o pkg/bling: - clean-up "bling_light.F" (fix typo related to PHYTO_SELF_SHADING option, move k-loop outside) ; add CHL to bling_ad_check_lev{2,3,4}_dir.h and diff --git a/model/src/the_model_main.F b/model/src/the_model_main.F index 0ee92f6e1..1e6c6a2d8 100644 --- a/model/src/the_model_main.F +++ b/model/src/the_model_main.F @@ -606,19 +606,19 @@ SUBROUTINE THE_MODEL_MAIN(myThid) C myIter :: Iteration counter for this thread INTEGER myIter _RL myTime - LOGICAL exst + LOGICAL costFinalExist LOGICAL lastdiva CEOP C-- set default: - exst = .TRUE. + costFinalExist = .TRUE. lastdiva = .TRUE. #ifdef ALLOW_DEBUG IF (debugMode) CALL DEBUG_ENTER('THE_MODEL_MAIN',myThid) #endif -#if defined(USE_PAPI) || defined(USE_PCL_FLOPS_SFP) || defined(USE_PCL_FLOPS) || defined(USE_PCL) +#if ( defined USE_PAPI || defined USE_PCL_FLOPS_SFP || defined USE_PCL_FLOPS || defined USE_PCL ) CALL TIMER_CONTROL('','INIT','THE_MODEL_MAIN',myThid) #endif C-- This timer encompasses the whole code @@ -635,81 +635,83 @@ SUBROUTINE THE_MODEL_MAIN(myThid) myTime = startTime myIter = nIter0 -#if ( defined (ALLOW_ADMTLM) ) +#ifdef ALLOW_ADMTLM STOP 'should never get here; ADMTLM_DSVD calls ADMTLM_DRIVER' -#elif ( defined (ALLOW_AUTODIFF)) +#elif ( defined ALLOW_AUTODIFF ) # ifdef ALLOW_CTRL -# ifndef EXCLUDE_CTRL_PACK IF ( useCTRL ) THEN - inquire( file='costfinal', exist=exst ) - IF ( .NOT. exst ) THEN - IF ( (optimcycle.NE.0 .OR. .NOT.doinitxx) - & .AND. doMainUnpack ) THEN - CALL TIMER_START('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) - CALL CTRL_UNPACK( .TRUE. , myThid ) - CALL TIMER_STOP ('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) - ENDIF - ENDIF - ENDIF -# endif /* EXCLUDE_CTRL_PACK */ -# endif +# ifndef EXCLUDE_CTRL_PACK + INQUIRE( FILE='costfinal', EXIST=costFinalExist ) + IF ( .NOT.costFinalExist ) THEN + IF ( (optimcycle.NE.0 .OR. .NOT.doinitxx) + & .AND. doMainUnpack ) THEN + CALL TIMER_START('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) + CALL CTRL_UNPACK( .TRUE. , myThid ) + CALL TIMER_STOP ('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) + ENDIF + ENDIF +# elif ( defined ALLOW_DIVIDED_ADJOINT ) + INQUIRE( FILE='costfinal', EXIST=costFinalExist ) +# endif /* EXCLUDE_CTRL_PACK & ALLOW_DIVIDED_ADJOINT */ + ENDIF +# endif /* ALLOW_CTRL */ # ifdef ALLOW_COST CALL COST_DEPENDENT_INIT ( myThid ) # endif -# if defined( ALLOW_TANGENTLINEAR_RUN ) - -# ifndef ALLOW_TAPENADE +# if ( defined ALLOW_TANGENTLINEAR_RUN ) -# ifdef ALLOW_DEBUG +# ifndef ALLOW_TAPENADE +# ifdef ALLOW_DEBUG IF (debugMode) CALL DEBUG_CALL('G_THE_MAIN_LOOP',myThid) -# endif +# endif CALL TIMER_START('G_THE_MAIN_LOOP [TANGENT RUN]',myThid) CALL G_THE_MAIN_LOOP ( myTime, myIter, myThid ) CALL TIMER_STOP ('G_THE_MAIN_LOOP [TANGENT RUN]',myThid) +# endif /* ndef ALLOW_TAPENADE */ -# endif /* ndef ALLOW_TAPENADE */ - -# elif defined( ALLOW_ADJOINT_RUN ) +# elif ( defined ALLOW_ADJOINT_RUN ) -# ifdef ALLOW_TAPENADE - CALL THE_MAIN_LOOP_B( myTime, myIter, myThid ) -# else /* ALLOW_TAPENADE */ +# ifdef ALLOW_TAPENADE + CALL THE_MAIN_LOOP_B( myTime, myIter, myThid ) +# else /* ALLOW_TAPENADE */ -# ifdef ALLOW_DIVIDED_ADJOINT +# ifdef ALLOW_DIVIDED_ADJOINT C-- The following assumes the TAF option '-pure' - inquire( file='costfinal', exist=exst ) - IF ( .NOT. exst) THEN -# ifdef ALLOW_DEBUG - IF (debugMode) CALL DEBUG_CALL('MDTHE_MAIN_LOOP',myThid) -# endif - CALL TIMER_START('MDTHE_MAIN_LOOP [MD RUN]', myThid) - CALL MDTHE_MAIN_LOOP ( myTime, myIter, myThid ) - CALL TIMER_STOP ('MDTHE_MAIN_LOOP [MD RUN]', myThid) - CALL COST_FINAL_STORE ( myThid, lastdiva ) + IF ( .NOT.costFinalExist ) THEN +# ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('MDTHE_MAIN_LOOP',myThid) +# endif + CALL TIMER_START('MDTHE_MAIN_LOOP [MD RUN]', myThid) + CALL MDTHE_MAIN_LOOP ( myTime, myIter, myThid ) + CALL TIMER_STOP ('MDTHE_MAIN_LOOP [MD RUN]', myThid) + CALL COST_FINAL_STORE ( lastdiva, myThid ) ELSE -# ifdef ALLOW_DEBUG - IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid) -# endif - CALL TIMER_START('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) - CALL ADTHE_MAIN_LOOP ( myThid ) - CALL TIMER_STOP ('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) - CALL COST_FINAL_RESTORE ( myThid, lastdiva ) +C-- for DIVA, avoid forward-related output in adjoint part + CALL TURNOFF_MODEL_IO( 1, myThid ) +# ifdef ALLOW_DEBUG + IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid) +# endif + CALL TIMER_START('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) + CALL ADTHE_MAIN_LOOP ( myThid ) + CALL TIMER_STOP ('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) + CALL COST_FINAL_RESTORE ( lastdiva, myThid ) ENDIF -# else /* ALLOW_DIVIDED_ADJOINT undef */ -# ifdef ALLOW_DEBUG +# else /* ALLOW_DIVIDED_ADJOINT undef */ +# ifdef ALLOW_DEBUG IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid) -# endif +# endif CALL TIMER_START('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) CALL ADTHE_MAIN_LOOP ( myThid ) CALL TIMER_STOP ('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) -# endif /* ALLOW_DIVIDED_ADJOINT */ -# endif /* ALLOW_TAPENADE */ +# endif /* ALLOW_DIVIDED_ADJOINT */ + +# endif /* ALLOW_TAPENADE */ # else /* forward run only within AD setting */ @@ -725,27 +727,25 @@ SUBROUTINE THE_MODEL_MAIN(myThid) # ifdef ALLOW_CTRL # ifndef EXCLUDE_CTRL_PACK - IF ( useCTRL ) THEN - IF ( lastdiva .AND. doMainPack ) THEN - CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) - CALL CTRL_PACK( .FALSE. , myThid ) - CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) - IF ( ( optimcycle.EQ.0 .OR. (.NOT. doMainUnpack) ) - & .AND. myIter.EQ.nIter0 ) THEN - CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) - CALL CTRL_PACK( .TRUE. , myThid ) - CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) - ENDIF - ENDIF + IF ( useCTRL .AND. lastdiva .AND. doMainPack ) THEN + CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) + CALL CTRL_PACK( .FALSE. , myThid ) + CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) + IF ( ( optimcycle.EQ.0 .OR. (.NOT. doMainUnpack) ) + & .AND. myIter.EQ.nIter0 ) THEN + CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) + CALL CTRL_PACK( .TRUE. , myThid ) + CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) + ENDIF ENDIF # endif /* EXCLUDE_CTRL_PACK */ # endif /* ALLOW_CTRL */ # ifdef ALLOW_GRDCHK IF ( useGrdchk .AND. lastdiva ) THEN - CALL TIMER_START('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) - CALL GRDCHK_MAIN( myThid ) - CALL TIMER_STOP ('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) + CALL TIMER_START('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) + CALL GRDCHK_MAIN( myThid ) + CALL TIMER_STOP ('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) ENDIF # endif @@ -762,13 +762,13 @@ SUBROUTINE THE_MODEL_MAIN(myThid) #endif /* ALLOW_TANGENTLINEAR_RUN ALLOW_ADJOINT_RUN ALLOW_ADMTLM */ #ifdef ALLOW_STREAMICE - IF (useStreamIce) THEN + IF ( useStreamIce ) THEN CALL STREAMICE_FINALIZE_PETSC ENDIF #endif #ifdef ALLOW_MNC - IF (useMNC) THEN + IF ( useMNC ) THEN C Close all open NetCDF files _BEGIN_MASTER( myThid ) CALL MNC_FILE_CLOSE_ALL( myThid ) @@ -781,8 +781,8 @@ SUBROUTINE THE_MODEL_MAIN(myThid) C-- Write timer statistics IF ( myThid .EQ. 1 ) THEN - CALL TIMER_PRINTALL( myThid ) - CALL COMM_STATS + CALL TIMER_PRINTALL( myThid ) + CALL COMM_STATS ENDIF C-- Check threads synchronization : diff --git a/pkg/cost/cost_final_restore.F b/pkg/cost/cost_final_restore.F index 2344bae18..cbd0374fb 100644 --- a/pkg/cost/cost_final_restore.F +++ b/pkg/cost/cost_final_restore.F @@ -3,68 +3,60 @@ # include "AUTODIFF_OPTIONS.h" #endif - subroutine cost_final_restore ( mythid, lastdiva ) +CBOP +C !ROUTINE: COST_FINAL_RESTORE -c ================================================================== -c SUBROUTINE cost_final_restore -c ================================================================== -c -c Restore cost function value -c This is required in conjunction with DIVA -c heimbach@mit.edu 5-Mar-2003 -c -c ================================================================== -c SUBROUTINE cost_final_restore -c ================================================================== +C !INTERFACE: + SUBROUTINE COST_FINAL_RESTORE( lastDiva, myThid ) - implicit none - -c == global variables == +C !DESCRIPTION: +C Restore cost function value +C This is required in conjunction with DIVA +C heimbach@mit.edu 5-Mar-2003 +C !USES: + IMPLICIT NONE +C == Global variables === #include "EEPARAMS.h" #include "SIZE.h" - #include "cost.h" -c == routine arguments == - - integer mythid - logical lastdiva - -# ifdef ALLOW_DIVIDED_ADJOINT - -c == local variables == - logical exst - - integer idivbeg, idivend -c == end of interface == - -c-- Each process has calculated the global part for itself. -cph IF (myProcId .eq. 0) THEN - _BEGIN_MASTER( mythid ) -c - inquire(file='divided.ctrl',exist=exst) - if (exst) then - open(unit=76,file='divided.ctrl',form='formatted') - read(unit=76,fmt=*) idivbeg,idivend - close(unit=76) - else - idivbeg = -2 - endif -c - if ( idivbeg .EQ. 0 ) then - lastdiva = .TRUE. - open(unit=76,file='costfinal') - read(76,*) fc - close(76) - else - lastdiva = .FALSE. - endif -c - _END_MASTER( mythid ) -cph ENDIF +C !INPUT/OUTPUT PARAMETERS: +C lastDiva :: True if last AD run from DIVA sequence, False otherwise +C myThid :: my Thread Id number + LOGICAL lastDiva + INTEGER myThid + +#ifdef ALLOW_DIVIDED_ADJOINT +C !LOCAL VARIABLES: + LOGICAL exst + INTEGER idivbeg, idivend +CEOP + + _BEGIN_MASTER( myThid ) + + INQUIRE(FILE='divided.ctrl',EXIST=exst) + IF (exst) THEN + OPEN(UNIT=76,FILE='divided.ctrl',FORM='formatted') + READ(UNIT=76,FMT=*) idivbeg,idivend + CLOSE(UNIT=76) + ELSE + idivbeg = -2 + ENDIF + + IF ( idivbeg .EQ. 0 ) THEN + lastDiva = .TRUE. + OPEN(UNIT=76,FILE='costfinal') + READ(76,*) fc + CLOSE(76) + ELSE + lastDiva = .FALSE. + ENDIF + + _END_MASTER( myThid ) _BARRIER -#endif +#endif /* ALLOW_DIVIDED_ADJOINT */ - end + RETURN + END diff --git a/pkg/cost/cost_final_store.F b/pkg/cost/cost_final_store.F index ed78e7926..dcd4888d6 100644 --- a/pkg/cost/cost_final_store.F +++ b/pkg/cost/cost_final_store.F @@ -3,52 +3,47 @@ # include "AUTODIFF_OPTIONS.h" #endif - subroutine cost_final_store ( mythid, lastdiva ) +CBOP +C !ROUTINE: COST_FINAL_STORE -c ================================================================== -c SUBROUTINE cost_final_store -c ================================================================== -c -c Store cost function value -c This is required in conjunction with DIVA -c heimbach@mit.edu 5-Mar-2003 -c -c ================================================================== -c SUBROUTINE cost_final_store -c ================================================================== +C !INTERFACE: + SUBROUTINE COST_FINAL_STORE( lastDiva, myThid ) - implicit none - -c == global variables == +C !DESCRIPTION: +C Store cost function value +C This is required in conjunction with DIVA +C heimbach@mit.edu 5-Mar-2003 +C !USES: + IMPLICIT NONE +C == Global variables === #include "EEPARAMS.h" #include "SIZE.h" - #include "cost.h" -c == routine arguments == - - integer mythid - logical lastdiva - -# ifdef ALLOW_DIVIDED_ADJOINT - -c == local variables == - -c == end of interface == - -c-- Each process has calculated the global part for itself. - lastdiva = .FALSE. - - IF (myProcId .eq. 0) THEN - _BEGIN_MASTER( mythid ) - open(unit=76,file='costfinal') - write(76,*) fc - close(76) - _END_MASTER( mythid ) +C !INPUT/OUTPUT PARAMETERS: +C lastDiva :: output argument, initialised to False (if DIVA) +C myThid :: my Thread Id number + LOGICAL lastDiva + INTEGER myThid + +#ifdef ALLOW_DIVIDED_ADJOINT +C !LOCAL VARIABLES: +CEOP + +C-- Each process has calculated the global part for itself. + lastDiva = .FALSE. + + IF ( myProcId .EQ. 0 ) THEN + _BEGIN_MASTER( myThid ) + OPEN(UNIT=76,FILE='costfinal') + WRITE(76,*) fc + CLOSE(76) + _END_MASTER( myThid ) ENDIF _BARRIER -#endif +#endif /* ALLOW_DIVIDED_ADJOINT */ - end + RETURN + END diff --git a/pkg/ctrl/ctrl_init_fixed.F b/pkg/ctrl/ctrl_init_fixed.F index 40b761009..7dfc18a22 100644 --- a/pkg/ctrl/ctrl_init_fixed.F +++ b/pkg/ctrl/ctrl_init_fixed.F @@ -53,7 +53,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) INTEGER bi, bj INTEGER i, j, k INTEGER ivar, iarr - LOGICAL costfinal_exists + LOGICAL costFinalExist _RL dummy _RL loctmp3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) @@ -110,15 +110,12 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) #endif #ifdef CTRL_DO_PACK_UNPACK_ONLY - costfinal_exists=.FALSE. -#else + costFinalExist = .FALSE. +#else /* CTRL_DO_PACK_UNPACK_ONLY */ c _BEGIN_MASTER( myThid ) - inquire( file='costfinal', exist=costfinal_exists ) + INQUIRE( FILE='costfinal', EXIST=costFinalExist ) c _END_MASTER( myThid ) - -C-- for DIVA, avoid forward-related output in adjoint part - IF ( costfinal_exists ) CALL TURNOFF_MODEL_IO( 1, myThid ) -#endif +#endif /* CTRL_DO_PACK_UNPACK_ONLY */ _BARRIER @@ -139,7 +136,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) iarr = 1 CALL ctrl_init_ctrlvar ( I xx_obcsn_file, ivar, iarr, diffrec, startrec, endrec, - I sNx, 1, Nr, 'm', 'SecXZ', costfinal_exists, myThid ) + I sNx, 1, Nr, 'm', 'SecXZ', costFinalExist, myThid ) #endif /* ALLOW_OBCSN_CONTROL */ C---------------------------------------------------------------------- @@ -154,7 +151,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) iarr = 2 CALL ctrl_init_ctrlvar ( I xx_obcss_file, ivar, iarr, diffrec, startrec, endrec, - I sNx, 1, Nr, 'm', 'SecXZ', costfinal_exists, myThid ) + I sNx, 1, Nr, 'm', 'SecXZ', costFinalExist, myThid ) #endif /* ALLOW_OBCSS_CONTROL */ C---------------------------------------------------------------------- @@ -169,7 +166,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) iarr = 4 CALL ctrl_init_ctrlvar ( I xx_obcsw_file, ivar, iarr, diffrec, startrec, endrec, - I 1, sNy, Nr, 'm', 'SecYZ', costfinal_exists, myThid ) + I 1, sNy, Nr, 'm', 'SecYZ', costFinalExist, myThid ) #endif /* ALLOW_OBCSW_CONTROL */ C---------------------------------------------------------------------- @@ -184,7 +181,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) iarr = 3 CALL ctrl_init_ctrlvar ( I xx_obcse_file, ivar, iarr, diffrec, startrec, endrec, - I 1, sNy, Nr, 'm', 'SecYZ', costfinal_exists, myThid ) + I 1, sNy, Nr, 'm', 'SecYZ', costFinalExist, myThid ) #endif /* ALLOW_OBCSE_CONTROL */ C---------------------------------------------------------------------- @@ -215,7 +212,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) C using model mean dRho/dz, see C MITgcm/verification/obcs_ctrl/input/gendata.m C This code is compatible with partial cells -#endif +#endif /* ALLOW_OBCS_CONTROL_MODES */ C---------------------------------------------------------------------- @@ -237,7 +234,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) CALL ctrl_init_ctrlvar ( I xx_genarr2d_file(iarr), I ivar, iarr, 1, 1, 1, - I sNx, sNy, 1, ncvargrdtmp, 'Arr2D', costfinal_exists, + I sNx, sNy, 1, ncvargrdtmp, 'Arr2D', costFinalExist, I myThid ) #ifndef ALLOW_OPENAD ENDIF @@ -257,7 +254,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) CALL ctrl_init_ctrlvar ( I xx_genarr3d_file(iarr), I ivar, iarr, 1, 1, 1, - I sNx, sNy, Nr, ncvargrdtmp, 'Arr3D', costfinal_exists, + I sNx, sNy, Nr, ncvargrdtmp, 'Arr3D', costFinalExist, I myThid ) #ifndef ALLOW_OPENAD ENDIF @@ -327,7 +324,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) I fnamegen, I 0, iarr, I diffrecFull, startrec, endrecFull, - I sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costfinal_exists, + I sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costFinalExist, I myThid ) WRITE(fnamegen,'(2a)') @@ -336,7 +333,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) I fnamegen, I 0, iarr, I diffrecFull, startrec, endrecFull, - I sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costfinal_exists, + I sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costFinalExist, I myThid ) C The length of adxx-files needs to be 1:endrec @@ -344,7 +341,7 @@ SUBROUTINE CTRL_INIT_FIXED( myThid ) I xx_gentim2d_file(iarr), I ivar, iarr, I endrec, 1, endrec, - I sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costfinal_exists, + I sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costFinalExist, I myThid ) #ifndef ALLOW_OPENAD diff --git a/pkg/diagnostics/diagnostics_init_early.F b/pkg/diagnostics/diagnostics_init_early.F index 815aec0cf..248e9c68a 100644 --- a/pkg/diagnostics/diagnostics_init_early.F +++ b/pkg/diagnostics/diagnostics_init_early.F @@ -1,7 +1,7 @@ #include "DIAG_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_INIT_EARLY C !INTERFACE: @@ -16,39 +16,39 @@ SUBROUTINE DIAGNOSTICS_INIT_EARLY( myThid ) C 2) GDIAG is defined as character*16 and can be to character*1 C parse(16) with the following codes currently defined: -C \begin{center} -C \begin{tabular}[h]{|c|c|}\hline -C \textbf{Positions} & \textbf{Characters} -C & \textbf{Meanings} \\\hline -C parse(1) & S & scalar \\ -C & U & vector component in X direction \\ -C & V & vector component in Y direction \\ -C & W & vector component in vertical direction \\ -C parse(2) & U & C-grid U-Point \\ -C & V & C-grid V-Point \\ -C & M & C-grid Mass Point \\ -C & Z & C-grid Corner Point \\ -C parse(3) & & Used for Level Integrated output: cumulate levels \\ -C & r & same but cumulate product by model level thickness \\ -C & R & same but cumulate product by hFac & level thickness \\ -C parse(4) & P & positive definite \\ -C parse(5 ) & C & with counter array \\ -C & P & post-processed (not filled up) from other diags \\ -C & D & disable an array for output \\ -C parse(6--8) & '123' & retired, formerly: 3-digit mate number \\ -C parse(9) & U & model-level plus 1/2 \\ -C & M & model-level middle \\ -C & L & model-level minus 1/2 \\ -C parse(10) & 0 & levels = 0 \\ -C & 1 & levels = 1 \\ -C & R & levels = Nr \\ -C & L & levels = MAX(Nr,NrPhys) \\ -C & M & levels = MAX(Nr,NrPhys) - 1 \\ -C & G & levels = Ground_level Number \\ -C & I & levels = sea-Ice_level Number \\ -C & X & free levels option (need to be set explicitly) \\ -C \end{tabular} -C \end{center} +C \begin{center} +C \begin{tabular}[h]{|c|c|}\hline +C \textbf{Positions} & \textbf{Characters} & \textbf{Meanings} \\\hline +C parse(1) & S & scalar \\ +C & U & vector component in X direction \\ +C & V & vector component in Y direction \\ +C & W & vector component in vertical direction \\ +C parse(2) & U & C-grid U-Point \\ +C & V & C-grid V-Point \\ +C & M & C-grid Mass Point \\ +C & Z & C-grid Corner Point \\ +C parse(3) & & Used for Level Integrated output: cumulate levels \\ +C & r & same but cumulate product by model level thickness \\ +C & R & same but cumulate product by hFac & level thickness \\ +C parse(4) & P & positive definite \\ +C & A & Adjoint variable diagnostics \\ +C parse(5 ) & C & with counter array \\ +C & P & post-processed (not filled up) from other diags \\ +C & D & disable an array for output \\ +C parse(6--8) & '123' & retired, formerly: 3-digit mate number \\ +C parse(9) & U & model-level plus 1/2 \\ +C & M & model-level middle \\ +C & L & model-level minus 1/2 \\ +C parse(10) & 0 & levels = 0 \\ +C & 1 & levels = 1 \\ +C & R & levels = Nr \\ +C & L & levels = MAX(Nr,NrPhys) \\ +C & M & levels = MAX(Nr,NrPhys) - 1 \\ +C & G & levels = Ground_level Number \\ +C & I & levels = sea-Ice_level Number \\ +C & X & free levels option (need to be set explicitly) \\ +C \end{tabular} +C \end{center} C !USES: IMPLICIT NONE diff --git a/pkg/diagnostics/diagnostics_init_fixed.F b/pkg/diagnostics/diagnostics_init_fixed.F index 4550d5d99..a4f7f5986 100644 --- a/pkg/diagnostics/diagnostics_init_fixed.F +++ b/pkg/diagnostics/diagnostics_init_fixed.F @@ -26,6 +26,9 @@ SUBROUTINE DIAGNOSTICS_INIT_FIXED(myThid) CEOP C !LOCAL VARIABLES: +c#ifdef ALLOW_DIVIDED_ADJOINT + LOGICAL dummyBoolean +c#endif C-- Set number of levels for all available diagnostics C (cannot add diags to list anymore after this call) @@ -43,13 +46,14 @@ SUBROUTINE DIAGNOSTICS_INIT_FIXED(myThid) C-- Calculate pointers for statistics-diags set to non-zero frequency CALL DIAGSTATS_SET_POINTERS( myThid ) - CALL DIAGSTATS_INI_IO( myThid ) - #ifdef ALLOW_FIZHI - if( useFIZHI) then - call fizhi_diagalarms(myThid) - endif + IF ( useFIZHI ) THEN + CALL FIZHI_DIAGALARMS( myThid ) + ENDIF #endif +c#ifdef ALLOW_DIVIDED_ADJOINT + CALL DIAGS_TRACK_DIVA( dummyBoolean, -2, myThid ) +c#endif RETURN END diff --git a/pkg/diagnostics/diagnostics_init_varia.F b/pkg/diagnostics/diagnostics_init_varia.F index 44a51f551..5025f3219 100644 --- a/pkg/diagnostics/diagnostics_init_varia.F +++ b/pkg/diagnostics/diagnostics_init_varia.F @@ -1,7 +1,7 @@ #include "DIAG_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_INIT_VARIA C !INTERFACE: @@ -33,6 +33,9 @@ SUBROUTINE DIAGNOSTICS_INIT_VARIA( myThid ) _END_MASTER( myThid ) _BARRIER +C-- Set I/O unit and open diag-stats ASCII output file: + CALL DIAGSTATS_INI_IO( myThid ) + C-- Zero out the qdiag array which accumulates during integration DO bj = myByLo(myThid), myByHi(myThid) DO bi = myBxLo(myThid), myBxHi(myThid) diff --git a/pkg/diagnostics/diagnostics_main_init.F b/pkg/diagnostics/diagnostics_main_init.F index c5d14ad80..67f8e15b3 100644 --- a/pkg/diagnostics/diagnostics_main_init.F +++ b/pkg/diagnostics/diagnostics_main_init.F @@ -1,7 +1,7 @@ #include "DIAG_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_MAIN_INIT C !INTERFACE: @@ -16,39 +16,39 @@ SUBROUTINE DIAGNOSTICS_MAIN_INIT( myThid ) C 2) GDIAG is defined as character*16 and can be to character*1 C parse(16) with the following codes currently defined: -C \begin{center} -C \begin{tabular}[h]{|c|c|}\hline -C \textbf{Positions} & \textbf{Characters} -C & \textbf{Meanings} \\\hline -C parse(1) & S & scalar \\ -C & U & vector component in X direction \\ -C & V & vector component in Y direction \\ -C & W & vector component in vertical direction \\ -C parse(2) & U & C-grid U-Point \\ -C & V & C-grid V-Point \\ -C & M & C-grid Mass Point \\ -C & Z & C-grid Corner Point \\ -C parse(3) & & Used for Level Integrated output: cumulate levels \\ -C & r & same but cumulate product by model level thickness \\ -C & R & same but cumulate product by hFac & level thickness \\ -C parse(4) & P & positive definite \\ -C parse(5 ) & C & with counter array \\ -C & P & post-processed (not filled up) from other diags \\ -C & D & disable an array for output \\ -C parse(6--8) & '123' & retired, formerly: 3-digit mate number \\ -C parse(9) & U & model-level plus 1/2 \\ -C & M & model-level middle \\ -C & L & model-level minus 1/2 \\ -C parse(10) & 0 & levels = 0 \\ -C & 1 & levels = 1 \\ -C & R & levels = Nr \\ -C & L & levels = MAX(Nr,NrPhys) \\ -C & M & levels = MAX(Nr,NrPhys) - 1 \\ -C & G & levels = Ground_level Number \\ -C & I & levels = sea-Ice_level Number \\ -C & X & free levels option (need to be set explicitly) \\ -C \end{tabular} -C \end{center} +C \begin{center} +C \begin{tabular}[h]{|c|c|}\hline +C \textbf{Positions} & \textbf{Characters} & \textbf{Meanings} \\\hline +C parse(1) & S & scalar \\ +C & U & vector component in X direction \\ +C & V & vector component in Y direction \\ +C & W & vector component in vertical direction \\ +C parse(2) & U & C-grid U-Point \\ +C & V & C-grid V-Point \\ +C & M & C-grid Mass Point \\ +C & Z & C-grid Corner Point \\ +C parse(3) & & Used for Level Integrated output: cumulate levels \\ +C & r & same but cumulate product by model level thickness \\ +C & R & same but cumulate product by hFac & level thickness \\ +C parse(4) & P & positive definite \\ +C & A & Adjoint variable diagnostics \\ +C parse(5 ) & C & with counter array \\ +C & P & post-processed (not filled up) from other diags \\ +C & D & disable an array for output \\ +C parse(6--8) & '123' & retired, formerly: 3-digit mate number \\ +C parse(9) & U & model-level plus 1/2 \\ +C & M & model-level middle \\ +C & L & model-level minus 1/2 \\ +C parse(10) & 0 & levels = 0 \\ +C & 1 & levels = 1 \\ +C & R & levels = Nr \\ +C & L & levels = MAX(Nr,NrPhys) \\ +C & M & levels = MAX(Nr,NrPhys) - 1 \\ +C & G & levels = Ground_level Number \\ +C & I & levels = sea-Ice_level Number \\ +C & X & free levels option (need to be set explicitly) \\ +C \end{tabular} +C \end{center} C !USES: IMPLICIT NONE diff --git a/pkg/diagnostics/diagnostics_out.F b/pkg/diagnostics/diagnostics_out.F index 811b73eea..c82258cf0 100644 --- a/pkg/diagnostics/diagnostics_out.F +++ b/pkg/diagnostics/diagnostics_out.F @@ -95,11 +95,11 @@ SUBROUTINE DIAGNOSTICS_OUT( CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid ) ENDIF iLen = ILNBLNK(fnames(listId)) - WRITE( fn, '(A,A,A)' ) fnames(listId)(1:iLen),'.',suff + WRITE(fn,'(3A)') fnames(listId)(1:iLen), '.', suff IF ( diag_mdsio.AND.(diagMdsDir.NE.' ') ) THEN jLen = ILNBLNK(diagMdsDir) - WRITE( fn, '(5A)' ) diagMdsDir(1:jLen),'/', - & fnames(listId)(1:iLen),'.',suff + WRITE(fn,'(5A)') diagMdsDir(1:jLen), '/', + & fnames(listId)(1:iLen), '.', suff ENDIF C- for now, if integrate vertically, output field has just 1 level: @@ -201,9 +201,9 @@ SUBROUTINE DIAGNOSTICS_OUT( C both of them have just been calculated and are still stored in qtmp: C => skip computation and just write qtmp2 IF ( diag_dBugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN - WRITE(ioUnit,'(A,I6,3A,I6)') - & ' get Post-Proc. Diag # ', ndId, ' ', cdiag(ndId), - & ' from previous computation of Diag # ', isComputed + WRITE(ioUnit,'(A,I6,3A,I6)') + & ' get Post-Proc. Diag # ', ndId, ' ', cdiag(ndId), + & ' from previous computation of Diag # ', isComputed ENDIF isComputed = 0 ELSEIF ( ndiag(ip,1,1).EQ.0 ) THEN @@ -214,27 +214,27 @@ SUBROUTINE DIAGNOSTICS_OUT( WRITE(msgBuf,'(A,I10)') & '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) WRITE(msgBuf,'(A,I6,3A,I4,2A)') - & '- WARNING - diag.#',ndId, ' : ',flds(md,listId), - & ' (#',md,' ) in outp.Stream: ',fnames(listId) + & '- WARNING - diag.#',ndId, ' : ',flds(md,listId), + & ' (#',md,' ) in outp.Stream: ',fnames(listId) CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) IF ( averageCycle(listId).GT.1 ) THEN WRITE(msgBuf,'(A,2(I3,A))') - & '- WARNING - has not been filled (ndiag(lm=',lm,')=', - & ndiag(ip,1,1), ' )' + & '- WARNING - has not been filled (ndiag(lm=',lm,')=', + & ndiag(ip,1,1), ' )' ELSE WRITE(msgBuf,'(A,2(I3,A))') - & '- WARNING - has not been filled (ndiag=', - & ndiag(ip,1,1), ' )' + & '- WARNING - has not been filled (ndiag=', + & ndiag(ip,1,1), ' )' ENDIF CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) WRITE(msgBuf,'(A)') - & 'WARNING DIAGNOSTICS_OUT => write ZEROS instead' + & 'WARNING DIAGNOSTICS_OUT => write ZEROS instead' CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) DO bj = myByLo(myThid), myByHi(myThid) DO bi = myBxLo(myThid), myBxHi(myThid) @@ -254,39 +254,40 @@ SUBROUTINE DIAGNOSTICS_OUT( IF ( diag_dBugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN IF ( ppFld.GE.1 ) THEN - WRITE(ioUnit,'(A,I6,7A,I8,2A)') - & ' Post-Processing Diag # ', ndId, ' ', cdiag(ndId), - & ' Parms: ',gdiag(ndId) + WRITE(ioUnit,'(A,I6,3A,I3,3A)') + & ' Post-Processing Diag #', ndId, ' "', cdiag(ndId), + & '" (list#', listId, ') Parms "', gdiag(ndId), '"' IF ( mDbl.EQ.0 ) THEN WRITE(ioUnit,'(2(3A,I6,A,I8))') ' from diag: ', & cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1) ELSE WRITE(ioUnit,'(2(3A,I6,A,I8))') ' from diag: ', & cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1), - & ' and diag: ', - & cdiag(mDbl),' (#',mDbl,') Cnt=',ndiag(im,1,1) + & ' and diag: ', + & cdiag(mDbl), ' (#', mDbl, ') Cnt=', ndiag(im,1,1) ENDIF ELSE - WRITE(ioUnit,'(A,I6,3A,I8,2A)') - & ' Computing Diagnostic # ', ndId, ' ', cdiag(ndId), - & ' Counter:',ndiag(ip,1,1),' Parms: ',gdiag(ndId) + WRITE(ioUnit,'(A,I6,3A,I3,3A,I8)') + & ' Computing Diagnostic #', ndId, ' "', cdiag(ndId), + & '" (list#', listId, ') Parms "', gdiag(ndId), + & '", Count=', ndiag(ip,1,1) ENDIF IF ( mate.GT.0 ) THEN - WRITE(ioUnit,'(3A,I6,2A)') - & ' use Counter Mate for ', cdiag(ndId), - & ' Diagnostic # ',mate, ' ', cdiag(mate) + WRITE(ioUnit,'(3A,I6,3A)') + & ' use Counter Mate for "', cdiag(ndId), + & '" : Diagnostic #', mate, ' "', cdiag(mate), '"' ELSEIF ( mVec.GT.0 ) THEN - IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN - WRITE(ioUnit,'(3A,I6,3A)') - & ' Vector Mate for ', cdiag(ndId), - & ' Diagnostic # ',mVec, ' ', cdiag(mVec), - & ' exists ' - ELSE - WRITE(ioUnit,'(3A,I6,3A)') - & ' Vector Mate for ', cdiag(ndId), - & ' Diagnostic # ',mVec, ' ', cdiag(mVec), - & ' not enabled' - ENDIF + IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN + WRITE(ioUnit,'(3A,I6,3A)') + & ' Vector Mate for "', cdiag(ndId), + & '" : Diagnostic # ', mVec, ' "', cdiag(mVec), + & '" exists' + ELSE + WRITE(ioUnit,'(3A,I6,3A)') + & ' Vector Mate for "', cdiag(ndId), + & '" : Diagnostic # ', mVec, ' "', cdiag(mVec), + & '" not enabled' + ENDIF ENDIF ENDIF diff --git a/pkg/diagnostics/diagnostics_set_pointers.F b/pkg/diagnostics/diagnostics_set_pointers.F index eaefc32e0..d9ab9d046 100644 --- a/pkg/diagnostics/diagnostics_set_pointers.F +++ b/pkg/diagnostics/diagnostics_set_pointers.F @@ -266,14 +266,14 @@ SUBROUTINE DIAGNOSTICS_SET_POINTERS( myThid ) WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ', & 'Set levels for Outp.Stream: ',fnames(ld) CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) suffix = ' Levels: ' IF ( fflags(ld)(2:2).EQ.'I' ) suffix = ' Sum Levels:' DO k1=1,nlevels(ld),20 k2 = MIN(nlevels(ld),k1+19) WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,ld),k=k1,k2) CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) ENDDO ELSEIF ( fflags(ld)(2:2).NE.'P' ) THEN C- if no Vert.Interpolation, check for levels out of range ( > kdiag): @@ -305,13 +305,14 @@ SUBROUTINE DIAGNOSTICS_SET_POINTERS( myThid ) ENDIF ENDDO - WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_POINTERS: done' - CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT , myThid) - WRITE(msgBuf,'(2A)') + WRITE(msgBuf,'(2A,2(I8,A))') 'DIAGNOSTICS_SET_POINTERS: done', + & ', use', ndiagcount, ' levels (numDiags =', numDiags, ' )' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(2A)') & '------------------------------------------------------------' - CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT , myThid) + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) diff --git a/pkg/diagnostics/diagnostics_switch_onoff.F b/pkg/diagnostics/diagnostics_switch_onoff.F index eafc60304..66bdf61cb 100644 --- a/pkg/diagnostics/diagnostics_switch_onoff.F +++ b/pkg/diagnostics/diagnostics_switch_onoff.F @@ -1,11 +1,14 @@ #include "DIAG_OPTIONS.h" +#ifdef ALLOW_AUTODIFF +# include "AUTODIFF_OPTIONS.h" +#endif C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_SWITCH_ONOFF C !INTERFACE: - SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( + SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( I seqFlag, myTime, myIter, myThid ) C !DESCRIPTION: @@ -38,7 +41,10 @@ SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( _RL myTime INTEGER myIter INTEGER myThid -CEOP + +C !FUNCTIONS + LOGICAL DIFF_PHASE_MULTIPLE + EXTERNAL DIFF_PHASE_MULTIPLE C !LOCAL VARIABLES: C newIter :: future iteration number @@ -51,16 +57,15 @@ SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( _RL phiSec, freqSec INTEGER nInterval _RL xInterval + LOGICAL firstCall LOGICAL dBugFlag INTEGER dBugUnit #ifdef ALLOW_FIZHI LOGICAL ALARM2NEXT EXTERNAL ALARM2NEXT - CHARACTER *9 tagname + CHARACTER*9 tagname #endif - - LOGICAL DIFF_PHASE_MULTIPLE - EXTERNAL DIFF_PHASE_MULTIPLE +CEOP C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| @@ -68,8 +73,16 @@ SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( dBugUnit = errorMessageUnit C-- Track diagnostics pkg activation status: - IF ( myIter.EQ.nIter0 ) THEN -c IF ( diag_pkgStatus.NE.10 ) STOP + firstCall = myIter.EQ.nIter0 + IF ( seqFlag.EQ.-1 ) THEN +#ifdef ALLOW_DIVIDED_ADJOINT + CALL DIAGS_TRACK_DIVA( firstCall, myIter, myThid ) +#else + firstCall = (myIter+1).EQ.nEndIter +#endif + ENDIF + IF ( firstCall .AND. ( seqFlag.EQ.1 .OR. seqFlag.EQ.-1 ) ) THEN +c IF ( seqFlag.EQ.1 .AND. diag_pkgStatus.NE.10 ) STOP _BARRIER _BEGIN_MASTER(myThid) diag_pkgStatus = ready2fillDiags diff --git a/pkg/diagnostics/diagnostics_utils.F b/pkg/diagnostics/diagnostics_utils.F index a14a04223..a764ebc61 100644 --- a/pkg/diagnostics/diagnostics_utils.F +++ b/pkg/diagnostics/diagnostics_utils.F @@ -6,14 +6,14 @@ C-- o DIAGNOSTICS_GET_DIAG C-- o DIAGNOSTICS_GET_POINTERS C-- o DIAGNOSTICS_SETKLEV +C-- o DIAGS_TRACK_DIVA C-- o DIAGS_GET_PARMS_I (Function) C-- o DIAGS_MK_UNITS (Function) C-- o DIAGS_MK_TITLE (Function) C-- o DIAGS_RENAMED (Function) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_COUNT C !INTERFACE: SUBROUTINE DIAGNOSTICS_COUNT( diagName, @@ -90,8 +90,7 @@ SUBROUTINE DIAGNOSTICS_COUNT( diagName, END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_GET_DIAG C !INTERFACE: @@ -197,8 +196,7 @@ SUBROUTINE DIAGNOSTICS_GET_DIAG( END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_GET_POINTERS C !INTERFACE: SUBROUTINE DIAGNOSTICS_GET_POINTERS( @@ -299,8 +297,7 @@ SUBROUTINE DIAGNOSTICS_GET_POINTERS( END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGNOSTICS_SETKLEV C !INTERFACE: @@ -406,8 +403,60 @@ SUBROUTINE DIAGNOSTICS_SETKLEV( END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP +C !ROUTINE: DIAGS_TRACK_DIVA + +C !INTERFACE: + SUBROUTINE DIAGS_TRACK_DIVA( + O divaFirst, + I myIter, myThid ) + +C !DESCRIPTION: +C Track status of Divided-Adjoint run by returning +C divaFirst=T if first call, and divaFirst=F otherwise +C Note: +C could figure out this with content of "divided.ctrl" file plus +C all nchklev_{1,2,3,4} and (myIter,nIter0,nEndIter) but easier to +C just check for first call (this avoids reading file divided.ctrl). + +C !USES: + IMPLICIT NONE +#include "EEPARAMS.h" +c#include "SIZE.h" + +C !INPUT PARAMETERS: +C myIter :: Current iteration number +C myThid :: my Thread Id number + INTEGER myIter + INTEGER myThid -CBOP 0 +C !OUTPUT PARAMETERS: +C divaFirst :: true if first call, otherwise set to false + LOGICAL divaFirst + +C !LOCAL VARIABLES: +C == Local variables in common block == + INTEGER keepTrackDivaRun(MAX_NO_THREADS) + COMMON / LOCAL_DIAGS_TRACK_DIVA / keepTrackDivaRun +C == Local variables == +CEOP + + IF ( myIter .EQ. -2 ) THEN +C-- Initialise variable in common block: + keepTrackDivaRun(myThid) = 0 + divaFirst = .FALSE. + ELSEIF ( keepTrackDivaRun(myThid).EQ.0 ) THEN + divaFirst = .TRUE. + keepTrackDivaRun(myThid) = 1 + ELSE + divaFirst = .FALSE. + ENDIF + + RETURN + END + +C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| +CBOP C !ROUTINE: DIAGS_GET_PARMS_I C !INTERFACE: @@ -458,8 +507,7 @@ INTEGER FUNCTION DIAGS_GET_PARMS_I( END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGS_MK_UNITS C !INTERFACE: @@ -538,8 +586,7 @@ CHARACTER*16 FUNCTION DIAGS_MK_UNITS( END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGS_MK_TITLE C !INTERFACE: @@ -607,8 +654,7 @@ CHARACTER*80 FUNCTION DIAGS_MK_TITLE( END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - -CBOP 0 +CBOP C !ROUTINE: DIAGS_RENAMED C !INTERFACE: diff --git a/pkg/diagnostics/diagnostics_write.F b/pkg/diagnostics/diagnostics_write.F index 90a22c557..1c3e38ef6 100644 --- a/pkg/diagnostics/diagnostics_write.F +++ b/pkg/diagnostics/diagnostics_write.F @@ -159,8 +159,7 @@ SUBROUTINE DIAGNOSTICS_WRITE( c IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP _BARRIER _BEGIN_MASTER(myThid) -C --- Do not disable diagnostics package for adj variables - IF ( .NOT.useDiag4AdjOutp ) diag_pkgStatus = 99 + diag_pkgStatus = 99 _END_MASTER(myThid) _BARRIER C Close all Stat-diags output files diff --git a/pkg/diagnostics/diagnostics_write_adj.F b/pkg/diagnostics/diagnostics_write_adj.F index b1c076f26..85323fed2 100644 --- a/pkg/diagnostics/diagnostics_write_adj.F +++ b/pkg/diagnostics/diagnostics_write_adj.F @@ -110,7 +110,20 @@ SUBROUTINE DIAGNOSTICS_WRITE_ADJ( _BARRIER ENDIF -C-- Clear storage space: +c IF ( modelStart ) THEN +C- Track diagnostics pkg activation status: +C Note: switching off diag_pkgStatus does not work since few ADJ-diags +C are filled outside S/R FORWARD_STEP_AD (e.g., "ADJetan " from +C initialise_varia_ad -> integr_continuity_ad. -> addummy_for_etan ) +cc IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP +c _BARRIER +c _BEGIN_MASTER(myThid) +c diag_pkgStatus = 99 +c _END_MASTER(myThid) +c _BARRIER +c ENDIF + +C-- Clear storage space: DO n = 1,nlists IF ( writeDiags(n) ) CALL DIAGNOSTICS_CLEAR(n,myThid) ENDDO diff --git a/pkg/diagnostics/diagstats_output.F b/pkg/diagnostics/diagstats_output.F index 33a282d74..63bbf4a65 100644 --- a/pkg/diagnostics/diagstats_output.F +++ b/pkg/diagnostics/diagstats_output.F @@ -86,16 +86,16 @@ SUBROUTINE DIAGSTATS_OUTPUT( C- Check for empty Diag (= not filled or using empty mask) IF ( tmp_Glob(0,0).EQ.0. ) THEN _BEGIN_MASTER( myThid ) - WRITE(msgBuf,'(A,I10,A,I4)') - & '- WARNING - from DIAGSTATS_OUTPUT at iter=', myIter, - & ' , region:', j + WRITE(msgBuf,'(2A,I10,A,I4)') '- WARNING -', + & ' from DIAGSTATS_OUTPUT at iter=', myIter, + & ' , region:', j CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) - WRITE(msgBuf,'(A,I6,3A,I4,2A)') - & '- WARNING - diagSt.#',ndId, ' : ',diagSt_Flds(m,listId), - & ' (#',m,' ) in outp.Stream: ',diagSt_Fname(listId) + & SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(2A,I6,3A,I4,2A)') '- WARNING -', + & ' diagSt.#', ndId, ' : ', diagSt_Flds(m,listId), + & ' (#', m, ' ) in outp.Stream: ', diagSt_Fname(listId) CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) IF ( kdiag(ndId).GT.nLev ) THEN WRITE(msgBuf,'(2(A,I4))') '- WARNING - kdiag=', & kdiag(ndId), ' exceeds local nLev=', nLev @@ -104,23 +104,25 @@ SUBROUTINE DIAGSTATS_OUTPUT( & ' OR using empty mask/region' ENDIF CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) WRITE(msgBuf,'(A)') - & 'WARNING DIAGSTATS_OUTPUT => write UNDEF instead' + & 'WARNING DIAGSTATS_OUTPUT => write UNDEF instead' CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, - & SQUEEZE_RIGHT, myThid) + & SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) ENDIF IF ( diag_dBugLevel .GE. debLevB ) THEN _BEGIN_MASTER( myThid ) - WRITE(ioUnit,'(A,I6,3A,I4,A,1PE10.3,2A)') - & ' Compute Stats, Diag. # ',ndId, ' ', cdiag(ndId), - & ' vol(',j,' ):', statGlob(0,0,j),' Parms: ',gdiag(ndId) + WRITE(ioUnit,'(A,I6,3A,I3,3A,I3,A,1PE10.3)') + & ' Compute Stats, Diag. #', ndId, ' "', cdiag(ndId), + & '" (list#', listId, ') Parms "', gdiag(ndId), + & '", vol(',j,' )=', statGlob(0,0,j) IF ( mate.GT.0 ) THEN - WRITE(ioUnit,'(A,I6,3A,I4,2(A,1PE10.3))') - & ' use Counter Mate # ', mate,' ',cdiag(mate), - & ' vol(',j,' ):',tmp_Glob(0,0), ' integral',tmp_Glob(1,0) + WRITE(ioUnit,'(A,I6,3A,I3,2(A,1PE10.3))') + & ' use Counter Mate #', mate, ' "', cdiag(mate), + & '" vol(',j,' )=', tmp_Glob(0,0), + & ', integral=', tmp_Glob(1,0) ENDIF _END_MASTER( myThid ) ENDIF diff --git a/pkg/diagnostics/diagstats_set_pointers.F b/pkg/diagnostics/diagstats_set_pointers.F index 488fd1ccd..7eeebcf66 100644 --- a/pkg/diagnostics/diagstats_set_pointers.F +++ b/pkg/diagnostics/diagstats_set_pointers.F @@ -37,7 +37,6 @@ SUBROUTINE DIAGSTATS_SET_POINTERS( myThid ) LOGICAL found, addMate2List, inList, regListPb CHARACTER*(MAX_LEN_MBUF) msgBuf - _BEGIN_MASTER( myThid) C-- Initialize pointer arrays to zero: @@ -116,7 +115,7 @@ SUBROUTINE DIAGSTATS_SET_POINTERS( myThid ) & ' space allocated for all stats-diags:', & ndiagcount, ' levels' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT , myThid) + & SQUEEZE_RIGHT, myThid ) ELSE IF ( ndiagcount.GT.diagSt_size ) THEN WRITE(msgBuf,'(2A)') @@ -168,13 +167,14 @@ SUBROUTINE DIAGSTATS_SET_POINTERS( myThid ) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - WRITE(msgBuf,'(A)') 'DIAGSTATS_SET_POINTERS: done' - CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT , myThid) - WRITE(msgBuf,'(2A)') + WRITE(msgBuf,'(2A,2(I8,A))') 'DIAGSTATS_SET_POINTERS: done', + & ', use', ndiagcount, ' levels (diagSt_size=', diagSt_size, ' )' + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) + WRITE(msgBuf,'(2A)') & '------------------------------------------------------------' - CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, - & SQUEEZE_RIGHT , myThid) + CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, + & SQUEEZE_RIGHT, myThid ) _END_MASTER( myThid ) diff --git a/pkg/openad/the_model_main.F b/pkg/openad/the_model_main.F index 613213abb..89c0f56af 100644 --- a/pkg/openad/the_model_main.F +++ b/pkg/openad/the_model_main.F @@ -1,514 +1,3 @@ -CBOI -C -C !TITLE: MITGCM KERNEL CODE SYNOPSIS -C !AUTHORS: mitgcm developers ( support@mitgcm.org ) -C !AFFILIATION: Massachussetts Institute of Technology -C !DATE: -C !INTRODUCTION: Kernel dynamical routines -C This document summarises MITgcm code under the model/ subdirectory. -C The code under model/ ( src/ and inc/ ) contains most of -C the driver routines for the baseline forms of the kernel equations in the -C MITgcm algorithm. Numerical code for much of the baseline forms of -C these equations is also under the model/ directory. Other numerical code -C used for the kernel equations is contained in packages in the pkg/ -C directory tree. -C Code for auxiliary equations and alternate discretizations of the kernel -C equations and algorithm can also be found in the pkg/ directory tree. -C -C \subsection{Getting Help and Reporting Errors and Problems} -C If you have questions please subscribe and e-mail support@mitgcm.org. -C We also welcome reports of errors and inconsistencies in the code or -C in the accompanying documentation. Please feel free to send these -C to support@mitgcm.org. For further information and to review -C problems reported to support@mitgcm.org please visit http://mitgcm.org. -C -C \subsection{MITgcm Kernel Code Calling Sequence} -C \bv -C -C Invocation from WRAPPER level... -C -C | -C |-THE_MODEL_MAIN :: Primary driver for the MITgcm algorithm -C | :: Called from WRAPPER level numerical -C | :: code invocation routine. On entry -C | :: to THE_MODEL_MAIN separate thread and -C | :: separate processes will have been established. -C | :: Each thread and process will have a unique ID -C | :: but as yet it will not be associated with a -C | :: specific region in decomposed discrete space. -C | -C |-INITIALISE_FIXED :: Set fixed model arrays such as topography, -C | | :: grid, solver matrices etc.. -C | | -C | |-INI_PARMS :: Routine to set kernel model parameters. -C | | :: Kernel parameters are read from file "data" -C | | :: in directory in which code executes. -C | | -C | |-PACKAGES_BOOT :: Start up the optional package environment. -C | | :: Runtime selection of active packages. -C | |-CPL_IMPORT_CPLPARMS :: Import coupling parameters from/to -C | | :: the coupler layer -C | |-PACKAGES_READPARMS :: Read each package input parameter file -C | | |- ${PKG}_READPARMS -C | | -C | |-SET_PARMS :: Finalise model parameter setting (if fct of pkg usage) -C | | -C | |-INI_MODEL_IO :: Initialise Input/Output setting -C | | |-MNC_INIT :: Initialise MITgcm NetCDF interface (MNC)(see pkg/mnc) -C | | |-MNC_CW_INIT :: Initialise MNC grid and variable types (see pkg/mnc) -C | | |-MON_INIT :: Initialises monitor package ( see pkg/monitor ) -C | | -C | |-INI_GRID :: Control grid array (vert. and horiz.) initialisation. -C | | | :: Grid arrays are held and described in GRID.h. -C | | |-LOAD_GRID_SPACING :: Load grid spacing (vector) from files -C | | |-INI_VERTICAL_GRID :: Set up vertical grid and coordinate -C | | |-INI_CARTESIAN_GRID :: Cartesian horiz. grid initialisation -C | | | :: (calculate grid from kernel parameters). -C | | |-INI_SPHERICAL_POLAR_GRID :: Spherical polar horiz. grid setting -C | | | :: (calculate grid from kernel parameters). -C | | |-INI_CURVILINEAR_GRID :: General orthogonal, structured horiz. grid -C | | | :: initialisation; input from raw grid files -C | | | :: (LONC.bin, LATC.bin, DXF.bin, ... ) or per -C | | | :: face file: horizGridFile(.faceXXX.bin) -C | | |-INI_CYLINDER_GRID :: Cylindrical horiz. grid setting -C | | -C | |-LOAD_REF_FILES :: Read-in reference vertical profiles (T,S,Rho) -C | |-INI_EOS :: Initialise Equation Of State (EOS) coefficients -C | |-SET_REF_STATE :: Set reference pressure/geopotential, reference -C | | :: stratification (for implicit IGW), vertical -C | | :: velocity scaling factor and anelastic ref. density -C | |-SET_GRID_FACTORS :: Set grid factors (fct of k) for deep-atmosphere -C | | -C | |-INI_DEPTHS :: Read (from "bathyFile") or set bathymetry/orography. -C | |-INI_MASKS_ETC :: Derive horizontal and vertical cell fractions and -C | | :: land masking for solid-fluid boundaries. -C | | -C | |-PACKAGES_INIT_FIXED :: do all packages fixed-initialisation setting -C | | |- ${PKG}_INIT_FIXED -C | | -C | |-INI_GLOBAL_DOMAIN :: Initialise domain related (global) quantities. -C | |-INI_LINEAR_PHISURF :: Set ref. surface Bo_surf -C | | -C | |-INI_CORI :: Set coriolis term. zero, f-plane, beta-plane, -C | | :: sphere options are coded. -C | |-INI_CG2D :: 2D conjugate grad solver initialisation. -C | |-INI_CG3D :: 3D conjugate grad solver initialisation. -C | | -C | |-CONFIG_SUMMARY :: Provide synopsis of kernel setup. Includes -C | | :: annotated table of kernel parameter settings. -C | | -C | |-PACKAGES_CHECK :: call each package configuration checking S/R -C | | |- ${PKG}_CHECK -C | | -C | |-CONFIG_CHECK :: Check config and parameter consistency. -C | | -C | |-WRITE_GRID :: write grid fields to output files -C | |-CPL_EXCH_CONFIGS :: exchange config with coupler-interface -C | -C |-CTRL_UNPACK :: Control vector support package. see pkg/ctrl -C |-COST_DEPENDENT_INIT :: ( see pkg/cost ) -C | -C |-ADTHE_MAIN_LOOP :: Derivative evaluating form of main time stepping loop -C ! :: Automatically generated by TAMC/TAF. -C | -C |-THE_MAIN_LOOP :: Main timestepping loop routine. -C | | -C | |-INITIALISE_VARIA :: Set the initial conditions for time evolving fields -C | | | -C #ifdef ALLOW_AUTODIFF -C | | |-INI_DEPTHS \ -C | | |-CTRL_DEPTH_INI \ -C | | |-UPDATE_MASKS_ETC } ALLOW_DEPTH_CONTROL case -C | | |-UPDATE_CG2D / -C #endif -C | | |-INI_NLFS_VARS :: Initialise all Non-Lin Free-Surf arrays (SURFACE.h) -C | | |-INI_DYNVARS :: Initialise to zero all DYNVARS.h arrays -C | | |-INI_NH_VARS :: Initialise to zero all NH_VARS.h arrays -C | | |-INI_FFIELDS :: Initialise forcing fields in FFIELDS.h to zero -C | | | -C | | |-INI_FIELDS :: Control initialising model fields to non-zero -C | | | |-INI_VEL :: Initialize 3D flow field. -C | | | |-INI_THETA :: Set model initial temperature field. -C | | | |-INI_SALT :: Set model initial salinity field. -C | | | |-INI_PSURF :: Set model initial free-surface height/pressure. -C | | | |-READ_PICKUP :: Read in main model pickup files to restart a run. -C | | | -C | | |-INI_MIXING :: Initialise diapycnal diffusivity. -C | | | -C | | |-TAUEDDY_INIT_VARIA :: Initialise eddy (bolus) streamfunction -C | | | -C | | |-INI_FORCING :: Set model initial forcing fields, either -C | | | | :: set in-line or from file as shown here: -C | | | |-READ_FLD_XY_RS(zonalWindFile) -C | | | |-READ_FLD_XY_RS(meridWindFile) -C | | | |-READ_FLD_XY_RS(surfQnetFile) -C | | | |-READ_FLD_XY_RS(EmPmRfile) -C | | | |-READ_FLD_XY_RS(thetaClimFile) -C | | | |-READ_FLD_XY_RS(saltClimFile) -C | | | |-READ_FLD_XY_RS(surfQswFile) -C | | | -C | | |-AUTODIFF_INIT_VARIA :: (see pkg/autodiff ) -C | | | -C | | |-PACKAGES_INIT_VARIABLES :: Does initialisation of time evolving -C | | | | ${PKG}_INIT_VARIA :: package data. -C | | | -C | | |-COST_INIT_VARIA :: ( see pkg/cost ) -C | | |-CONVECTIVE_ADJUSTMENT_INI :: Apply conv. adjustment to initial state -C | | | -C | | |-CALC_R_STAR :: Calculate the new level thickness factor (r* coord) -C | | |-UPDATE_R_STAR :: Update the level thickness fraction (r* coord). -C | | |-UPDATE_SIGMA :: Update the level thickness fraction (sigma-coord). -C | | |-CALC_SURF_DR :: Calculate the new surface level thickness. -C | | |-UPDATE_SURF_DR :: Update the surface-level thickness fraction. -C | | | -C | | |-UPDATE_CG2D :: Update 2D conjugate grad. for Free-Surf. -C | | | -C | | |-INTEGR_CONTINUITY :: Integrate the continuity Equation -C | | | |-INTEGRATE_FOR_W :: Integrate for vertical velocity -C | | | |-OBCS_APPLY_W :: Open boundary package (see pkg/obcs). -C | | | |-DUMMY_FOR_ETAN :: For printing adEtaN (see pkg/autodiff). -C | | | |-UPDATE_ETAH :: Update Surface height/pressure -C | | | -C | | |-CALC_R_STAR :: Calculate the new level thickness factor (r* coord) -C | | |-CALC_SURF_DR :: Calculate the new surface level thickness. -C | | | -C | | |-STATE_SUMMARY :: Summarise model prognostic variables. -C | | | -C | | |-MONITOR :: Monitor state (see pkg/monitor) -C | | | -C | | |-DO_STATEVARS_TAVE :: Time averaging package ( see pkg/timeave ). -C | | | |-TIMEAVE_STATVARS :: Accumulate main model state variables -C | | | |-PTRACERS_TIMEAVE :: Accumulate passive tracers variables -C | | | -C | | |-DO_THE_MODEL_IO :: Controlling routine for IO -C | | | |-WRITE_STATE :: Write model state variables. -C | | | |-TIMEAVE_STATV_WRITE :: Write Time averaged output (see pkg/timeave) -C | | | |-FIZHI_WRITE_STATE :: Write Fizhi pkg output (see pkg/fizhi) -C | | | |-AIM_WRITE_TAVE :: Write AIM pkg output (see pkg/aim_v23) -C | | | |-LAND_OUTPUT :: Write Land pkg output (see pkg/land) -C | | | |-OBCS_OUTPUT :: Write OBCS pkg output (see pkg/obcs) -C | | | |-GMREDI_OUTPUT :: Write GM-Redi pkg output (see pkg/gmredi) -C | | | |-KPP_OUTPUT :: Write KPP pkg output (see pkg/kpp) -C | | | |-PP81_OUTPUT :: Write PP81 pkg output (see pkg/pp81) -C | | | |-KL10_OUTPUT :: Write KL10 pkg output (see pkg/kl10) -C | | | |-MY82_OUTPUT :: Write MY82 pkg output (see pkg/my82) -C | | | |-OPPS_OUTPUT :: Write OPPS pkg output (see pkg/opps) -C | | | |-GGL90_OUTPUT :: Write GGL90 pkg output (see pkg/ggl90) -C | | | |-SBO_CALC :: Compute SBO diagnostics (see pkg/sbo) -C | | | |-SBO_OUTPUT :: Write SBO pkg output (see pkg/sbo) -C | | | |-SEAICE_OUTPUT :: Write SeaIce pkg output (see pkg/seaice) -C | | | |-SHELFICE_OUTPUT :: Write ShelfIce pkg output (see pkg/shelfice) -C | | | |-BULKF_OUTPUT :: Write Bulk-Force output (see pkg/bulK_force) -C | | | |-THSICE_OUTPUT :: Write ThSIce pkg output (see pkg/thsice) -C | | | |-PTRACERS_OUTPUT :: Write pTracers pkg output (see pkg/ptracers) -C | | | |-MATRIX_OUTPUT :: Write Matrix pkg output (see pkg/matrix) -C | | | |-GCHEM_OUTPUT :: Write Geochemistry pkg output (see pkg/gchem) -C | | | |-CPL_OUTPUT :: Write Coupler-Interface output (see -C | | | | :: pkg/atm_compon_interf, pkg/ocn_compon_interf) -C | | | |-LAYERS_CALC :: Calculate layers diagnostics (see pkg/layers) -C | | | |-LAYERS_OUTPUT :: Write Layers pkg output (see pkg/layers) -C | | | |-DIAGNOSTICS_WRITE :: Write pkg/diagnostics output -C | | | -C====|>| **************************** -C====|>| BEGIN MAIN TIMESTEPPING LOOP -C====|>| **************************** -C | |-COST_AVERAGESFIELDS :: time-averaged Cost function terms (see pkg/cost) -C | |-PROFILES_INLOOP :: ( see pkg/profiles ) -C | / -C | |-MAIN_DO_LOOP :: Open-AD case: Main timestepping loop routine -C | \ otherwise: just call FORWARD_STEP -C | | -C/\ | |-FORWARD_STEP :: Step forward a time-step ( AT LAST !!! ) -C/\ | | | -C/\ | | |-AUTODIFF_INADMODE_UNSET :: Set/reset some adjoint flags -C/\ | | |-RESET_NLFS_VARS :: Reset some Non-Lin Free-Surf vars (Adjoint) -C/\ | | |-UPDATE_R_STAR :: Reset r-star factor variables (Adjoint) -C/\ | | |-UPDATE_SURF_DR :: Reset NLFS surface thickness vars (Adjoint) -C/\ | | | -C/\ | | |-PTRACERS_SWITCH_ONOFF :: Set/reset pTracers time-stepping switch -C/\ | | |-DIAGNOSTICS_SWITCH_ONOFF :: Activate/de-activate diagnostics -C/\ | | |-DO_STATEVARS_DIAGS ( 0 ) :: fill-up state variable diagnostics -C/\ | | | -C/\ | | |-NEST_CHILD_SETMEMO :: Nesting interface -C/\ | | |-NEST_PARENT_IO_1 :: Nesting interface -C/\ | | | -C/\ | | |-LOAD_FIELDS_DRIVER :: Control loading of input fields from files -C/\ | | | -C/\ | | |-BULKF_FORCING :: Calculate surface forcing (see pkg/bulk_force) -C/\ | | |-CHEAPAML :: Cheap AML driver ( see pkg/cheapaml ) -C/\ | | |-CTRL_MAP_FORCING :: Control vector support package. (see pkg/ctrl) -C/\ | | |-DUMMY_IN_STEPPING :: Autodiff package ( pkg/autodiff ). -C/\ | | | -C/\ | | |-CPL_EXPORT_MY_DATA :: Send coupling fields to coupler -C/\ | | |-CPL_IMPORT_EXTERNAL_DATA :: Receive coupling fields from coupler -C/\ | | | -C/\ | | |-OASIS_PUT :: Oasis coupler interface -C/\ | | |-OASIS_GET :: Oasis coupler interface -C/\ | | | -C/\ | | |-EBM_DRIVER :: Calculate EBM type atmospheric forcing (see pkg/ebm) -C/\ | | | -C/\ | | |-DO_ATMOSPHERIC_PHYS :: Atmospheric physics computation -C/\ | | | | -C/\ | | | |-UPDATE_OCEAN_EXPORTS :: ( see pkg/fizhi ) -C/\ | | | |-UPDATE_EARTH_EXPORTS :: ( see pkg/fizhi ) -C/\ | | | |-UPDATE_CHEMISTRY_EXPORTS :: ( see pkg/fizhi ) -C/\ | | | |-FIZHI_WRAPPER :: ( see pkg/fizhi ) -C/\ | | | |-STEP_FIZHI_FG :: ( see pkg/fizhi ) -C/\ | | | |-FIZHI_UPDATE_TIME :: ( see pkg/fizhi ) -C/\ | | | | -C/\ | | | |-ATM_PHYS_DRIVER :: ( see pkg/atm_phys ) -C/\ | | | | -C/\ | | | |-AIM_DO_PHYSICS :: ( see pkg/aim_v23 ) -C/\ | | | -C/\ | | |-DO_OCEANIC_PHYS :: Oceanic (& seaice) physics computation -C/\ | | | | -C/\ | | | |-OBCS_CALC :: Open boundary. package (see pkg/obcs). -C/\ | | | | -C/\ | | | |-FRAZIL_CALC_RHS :: Compute FRAZIL tendencies ( see pkg/frazil ) -C/\ | | | |-THSICE_MAIN :: Thermodynamic sea-ice driver (see pkg/thsice) -C/\ | | | |-SEAICE_MODEL :: Sea-ice model driver (see pkg/seaice ) -C/\ | | | |-SEAICE_COST_SENSI :: Sea-ice cost-function (see pkg/seaice ) -C/\ | | | |-SHELFICE_THERMODYNAMICS :: Compute ShelfIce thermo (pkg/shelfice) -C/\ | | | |-ICEFRONT_THERMODYNAMICS :: Compute IceFront thermo (pkg/icefront) -C/\ | | | | -C/\ | | | |-SALT_PLUME_DO_EXCH :: (see pkg/salt_plume ) -C/\ | | | |-FREEZE_SURFACE :: Prevent SST to fall below TFreeze -C/\ | | | |-OCN_APPLY_IMPORT :: Apply imported fields from coupler -C/\ | | | |-EXTERNAL_FORCING_SURF:: Compute appropriately dimensioned -C/\ | | | | :: surface forcing terms. -C/\ | | | |-FIND_RHO_2D @ p(k) :: Calculate [rho(T,S,p)-Rho_0] of a slice -C/\ | | | |-FIND_RHO_2D @ p(k-1) :: Calculate [rho(T,S,p)-Rho_0] of a slice -C/\ | | | |-GRAD_SIGMA :: Calculate isoneutral gradients -C/\ | | | |-CALC_IVDC :: Set Implicit Vertical Diffusivity for Convection -C/\ | | | |-CALC_OCE_MXLAYER :: Diagnose Oceanic Mixed Layer depth -C/\ | | | | -C/\ | | | |-SALT_PLUME_CALC_DEPTH :: (see pkg/salt_plume ) -C/\ | | | |-SALT_PLUME_VOLFRAC :: (see pkg/salt_plume ) -C/\ | | | |-SALT_PLUME_APPLY (Temp) :: (see pkg/salt_plume ) -C/\ | | | |-SALT_PLUME_APPLY (Salt) :: (see pkg/salt_plume ) -C/\ | | | |-SALT_PLUME_FORCING_SURF :: (see pkg/salt_plume ) -C/\ | | | |-KPP_CALC :: Compute KPP vertical mixing ( see pkg/kpp ) -C/\ | | | |-PP81_CALC :: Compute PP81 vertical mixing ( see pkg/pp81 ) -C/\ | | | |-KL10_CALC :: Compute KL10 vertical mixing ( see pkg/kl10 ) -C/\ | | | |-MY82_CALC :: Compute MY82 vertical mixing ( see pkg/kl10 ) -C/\ | | | |-GGL90_CALC :: Compute GGL90 vertical mixing (see pkg/ggl10) -C/\ | | | |-GMREDI_CALC_TENSOR :: Compute GM-Redi tensor ( see pkg/gmredi ) -C/\ | | | |-DWNSLP_CALC_FLOW :: Compute Down-Slope flow (see pkg/down_slope) -C/\ | | | |-BBL_CALC_RHS :: Compute BBL tendencies ( see pkg/bbl ) -C/\ | | | |-MYPACKAGE_CALC_RHS :: Compute mypackage tendencies (pkg/mypackage) -C/\ | | | | -C/\ | | | |-GMREDI_DO_EXCH :: ( see pkg/gmredi ) -C/\ | | | |-KPP_DO_EXCH :: ( see pkg/kpp ) -C/\ | | | |-DIAGS_RHO_G :: Compute some density related diagnostics -C/\ | | | |-DIAGS_OCEANIC_SURF_FLUX :: Diagnose oceanic surface fluxes -C/\ | | | |-SALT_PLUME_DIAGNOSTICS_FILL :: (see pkg/salt_plume ) -C/\ | | | |-ECCO_PHYS :: ( see pkg/ecco ) -C/\ | | | -C/\ | | |-STREAMICE_TIMESTEP :: ( see pkg/streamice ) -C/\ | | | -C/\ | | |-GCHEM_CALC_TENDENCY :: geochemistry driver routine (see pkg/gchem) -C/\ | | | -C/\ | | |-LONGSTEP_AVERAGE :: Averaging state vars ( see pkg/longstep ) -C/\ | | |-LONGSTEP_THERMODYNAMICS :: Step forward tracers ( see pkg/longstep ) -C/\ | | | -C/\ | | |-THERMODYNAMICS :: theta, salt + tracer equations driver. -C/\ | | | | (synchronous time-stepping case) -C/\ | | | |-CALC_WSURF_TR :: Compute T & S Linear-Free-Surf correction -C/\ | | | |-PTRACERS_CALC_WSURF_TR :: Compute Tracers Linear-Free-Surf correct. -C/\ | | | | -C/\ | | | |-GMREDI_RESIDUAL_FLOW :: Get the flow field used to advect tracers -C/\ | | | | -C/\ | | | |-TEMP_INTEGRATE :: Step forward Prognostic Eq for Temperature. -C/\ | | | | | -C/\ | | | | |-ADAMS_BASHFORTH3 :: Extrapolate tracer forward in time (AB-3) -C/\ | | | | |-ADAMS_BASHFORTH2 :: Extrapolate tracer forward in time (AB-2) -C/\ | | | | |-CALC_3D_DIFFUSIVITY :: set vertical diffusivity -C/\ | | | | | -C/\ | | | | |-GAD_SOM_ADVECT :: Second Order Moment (SOM) advection -C/\ | | | | |-GAD_ADVECTION :: Generalised advection driver (multi-dim -C/\ | | | | | advection case) (see pkg/gad). -C/\ | | | | |-CALC_ADV_FLOW :: set 3-D flow field to advect tracer -C/\ | | | | |-APPLY_FORCING_T :: Problem specific forcing for temperature. -C/\ | | | | |-GAD_CALC_RHS :: Calculate Advection-Diffusion tendency terms -C/\ | | | | | -C/\ | | | | |-ADAMS_BASHFORTH3 :: Extrapolate tendency forward in time (AB-3) -C/\ | | | | |-ADAMS_BASHFORTH2 :: Extrapolate tendency forward in time (AB-2) -C/\ | | | | |-FREESURF_RESCALE_G :: Re-scale Gt for free-surface height. -C/\ | | | | |-DWNSLP_APPLY :: Add pkg/down_slope tendency -C/\ | | | | | -C/\ | | | | |-TIMESTEP_TRACER :: Step tracer field forward in time -C/\ | | | | | -C/\ | | | | |-GAD_IMPLICIT_R :: Solve vertical implicit Advect-Diffus. eqn. -C/\ | | | | |-IMPLDIFF :: Solve vertical implicit diffusion equation. -C/\ | | | | |-CYCLE_AB_TRACER :: Cycle time-stepping arrays for tracer field -C/\ | | | | |-CYCLE_TRACER :: Cycle time-stepping arrays for tracer field -C/\ | | | | -C/\ | | | |-SALT_INTEGRATE :: Step forward Prognostic Eq for Salinity. -C/\ | | | | | same sequence of calls as in TEMP_INTEGRATE -C/\ | | | | -C/\ | | | |-PTRACERS_INTEGRATE :: Integrate other tracer(s) (see pkg/ptracers). -C/\ | | | | | same sequence of calls as in TEMP_INTEGRATE -C/\ | | | | |-OBCS_APPLY_PTRACER :: Open boundary package for pTracers -C/\ | | | | -C/\ | | | |-OBCS_APPLY_TS :: Open boundary package (see pkg/obcs ). -C/\ | | | -C/\ | | |-LONGSTEP_AVERAGE :: Averaging state vars ( see pkg/longstep ) -C/\ | | |-LONGSTEP_THERMODYNAMICS :: Step forward tracers ( see pkg/longstep ) -C/\ | | | -C/\ | | |-DO_STAGGER_FIELDS_EXCHANGES :: Update overlap regions of arrays -C/\ | | | Theta & Salt (implicit IGW case) -C/\ | | | -C/\ | | |-DYNAMICS :: Momentum equations driver. -C/\ | | | | -C/\ | | | |-CALC_GRAD_PHI_SURF :: Calculate the gradient of the surface -C/\ | | | | Potential anomaly. -C/\ | | | |-CALC_VISCOSITY :: Calculate net vertical viscosity -C/\ | | | |-MOM_CALC_3D_STRAIN :: Calculates the strain tensor of 3D flow field -C/\ | | | |-OBCS_COPY_UV_N :: for Stevens bndary Conditions (see pkg/obcs) -C/\ | | | | -C/\ | | | |-CALC_PHI_HYD :: Integrate the hydrostatic relation. -C/\ | | | |-MOM_FLUXFORM :: Flux Form momentum eqn. (pkg/mom_fluxform) -C/\ | | | |-MOM_VECINV :: Vector Invariant momentum eqn (pkg/mom_vecinv) -C/\ | | | |-MOM_CALC_SMAG_3D :: Calculate Smagorinsky 3D (harmonic) viscosities -C/\ | | | |-MOM_UV_SMAG_3D :: Calculate U,V mom. tendency due to Smag 3D Visc -C/\ | | | |-TIMESTEP :: Step horizontal momentum fields forward in time -C/\ | | | | -C/\ | | | |-MOM_U_IMPLICIT_R :: Solve implicitly vertical Adv-Diffus equation. -C/\ | | | |-IMPLDIFF :: Solve vertical implicit diffusion equation. -C/\ | | | |-OBCS_SAVE_UV_N :: for Stevens bndary Conditions (see pkg/obcs) -C/\ | | | |-OBCS_APPLY_UV :: Apply Open bndary Conditions to provisional U,V -C/\ | | | |-IMPLDIFF :: (CD-Scheme) Solve vertical impl. diffus. eqn -C/\ | | | | -C/\ | | | |-CALC_GW :: Vert. momentum tendency terms (Non-Hydrostatic) -C/\ | | | | |-MOM_W_SMAG_3D :: Calculate W mom. tendency due to Smag 3D Visc -C/\ | | | |-TIMESTEP_WVEL :: Step vert mom forward in time (Non-Hydrostatic) -C/\ | | | -C/\ | | |-MNC_UPDATE_TIME :: Update MNC time record (see pkg/mnc) -C/\ | | | -C/\ | | |-UPDATE_R_STAR :: Update the level thickness fraction (r* coord). -C/\ | | |-UPDATE_SIGMA :: Update the level thickness fraction (sigma-coord). -C/\ | | |-UPDATE_R_STAR :: Update the level thickness fraction. -C/\ | | |-UPDATE_SURF_DR :: Update the surface-level thickness fraction. -C/\ | | |-UPDATE_CG2D :: Update 2D conjugate grad. for Free-Surf. -C/\ | | | -C/\ | | |-SHAP_FILT_APPLY_UV :: Apply Shapiro Filter to provisional velocity -C/\ | | |-ZONAL_FILT_APPLY_UV :: Apply Zonal Filter to provisional velocity -C/\ | | | -C/\ | | |-SOLVE_FOR_PRESSURE :: Find surface pressure. -C/\ | | | |-CALC_DIV_GHAT :: Form the RHS of the surface pressure eqn. -C/\ | | | |-CG2D :: Two-dim pre-con. conjugate-gradient. -C/\ | | | |-PRE_CG3D :: Finish to set the RHS of the 3-D pressure eqn. -C/\ | | | |-CG3D :: Three-dim pre-con. conjugate-gradient solver. -C/\ | | | |-POST_CG3D :: finalise solution of NH and Free-Surf pressure -C/\ | | | -C/\ | | |-MOMENTUM_CORRECTION_STEP :: Finalise momentum stepping -C/\ | | | |-CALC_GRAD_PHI_SURF :: Return DDx and DDy of surface pressure -C/\ | | | |-CORRECTION_STEP :: Pressure correction to momentum -C/\ | | | |-OBCS_APPLY_UV :: Open boundary package (see pkg/obcs). -C/\ | | | |-SHAP_FILT_APPLY_UV :: Apply Shapiro Filter to latest velocity -C/\ | | | |-ZONAL_FILT_APPLY_UV :: Apply Zonal Filter to latest velocity -C/\ | | | -C/\ | | |-INTEGR_CONTINUITY :: Integrate continuity equation (see above) -C/\ | | | -C/\ | | |-CALC_R_STAR :: Calculate the new level thickness factor (r* coord) -C/\ | | |-CALC_SURF_DR :: Calculate the new surface level thickness. -C/\ | | | -C/\ | | |-DO_STAGGER_FIELDS_EXCHANGES :: Update overlap regions of arrays -C/\ | | | uVel,vVel & wVel (stagger-time-step case) -C/\ | | | -C/\ | | |-DO_STATEVARS_DIAGS ( 1 ) :: fill-up state variable diagnostics -C/\ | | | -C/\ | | |-THERMODYNAMICS :: theta, salt + tracer Eq. driver (see above). -C/\ | | | (staggered time-stepping case) -C/\ | | | -C/\ | | |-TRACERS_CORRECTION_STEP :: Finalise tracer stepping: -C/\ | | | | :: apply filter, conv.adjustment -C/\ | | | |-TRACERS_IIGW_CORRECTION :: apply Implicit IGW adjustment to T & S -C/\ | | | |-SHAP_FILT_APPLY_TS :: Apply Shapiro Filter to latest T & S -C/\ | | | |-ZONAL_FILT_APPLY_TS :: Apply Zonal Filter to latest T & S -C/\ | | | |-PTRACERS_ZONAL_FILT_APPLY :: Apply Zonal Filter to pTracers -C/\ | | | |-SALT_FILL :: Fill up negative Salt -C/\ | | | |-OPPS_INTERFACE :: ( see pkg/opps ) -C/\ | | | |-CONVECTIVE_ADJUSTMENT :: Apply convective adjustment -C/\ | | | |-MATRIX_STORE_TENDENCY_IMP :: ( see pkg/matrix ) -C/\ | | | -C/\ | | |-LONGSTEP_AVERAGE :: Averaging state vars ( see pkg/longstep ) -C/\ | | |-LONGSTEP_THERMODYNAMICS :: Step forward tracers ( see pkg/longstep ) -C/\ | | | -C/\ | | |-GCHEM_FORCING_SEP :: Tracer forcing for gchem pkg (if tracer -C/\ | | | :: dependent tendencies calculated separately) -C/\ | | | -C/\ | | |-DO_FIELDS_BLOCKING_EXCHANGES :: Sync up overlap regions. -C/\ | | | -C/\ | | |-DO_STATEVARS_DIAGS ( 2 ) :: fill-up state variable diagnostics -C/\ | | | -C/\ | | |-GRIDALT_UPDATE :: ( see pkg/gridalt ) -C/\ | | |-STEP_FIZHI_CORR :: ( see pkg/fizhi ) -C/\ | | | -C/\ | | |-FLT_MAIN :: Step forward Floats (see pkg/flt) -C/\ | | | -C/\ | | |-DO_STATEVARS_TAVE :: Time averaging package (see above) -C/\ | | | -C/\ | | |-NEST_PARENT_IO_2 :: Nesting interface -C/\ | | |-NEST_CHILD_TRANSP :: Nesting interface -C/\ | | | -C/\ | | |-MONITOR :: Monitor package (pkg/monitor). -C/\ | | | -C/\ | | |-COST_TILE :: ( see pkg/cost ) -C/\ | | | -C/\ | | |-DO_THE_MODEL_IO :: Controlling routine for IO (see above) -C/\ | | | -C/\ | | |-PTRACERS_RESET :: Re-initialize PTRACERS ( see pkg/ptracers ) -C/\ | | | -C/\ | | |-DO_WRITE_PICKUP :: Controlling routine for writing files to restart -C/\ | | | |-PACKAGES_WRITE_PICKUP :: Write pickup files for each package -C/\ | | | | | :: which needs it to restart -C/\ | | | | |-GAD_WRITE_PICKUP :: Write Generic AdvDiff pickups for SOM -C/\ | | | | | :: advection scheme (pkg/generic_advdiff) -C/\ | | | | |-CD_CODE_WRITE_PICKUP :: Write CD-code pickups (see pkg/cd_code) -C/\ | | | | |-OBCS_WRITE_PICKUP :: Write OBCS pickups (see pkg/obcs) -C/\ | | | | |-GGL90_WRITE_PICKUP :: Write GGL90 pickups (see pkg/ggl90) -C/\ | | | | |-BBL_WRITE_PICKUP :: Write BBL pickups (see pkg/bbl) -C/\ | | | | |-CHEAPAML_WRITE_PICKUP :: Write CheapAML pickups (pkg/cheapaml) -C/\ | | | | |-FLT_WRITE_PICKUP :: Write Floats pickups (see pkg/flt) -C/\ | | | | |-PTRACERS_WRITE_PICKUP :: Write pTracers pickups (pkg/ptracers) -C/\ | | | | |-GCHEM_WRITE_PICKUP :: Write Geo-Chem pickups (see pkg/gchem) -C/\ | | | | |-SEAICE_WRITE_PICKUP :: Write SeaIce pickups (see pkg/seaice) -C/\ | | | | |-STREAMICE_WRITE_PICKUP :: Write StreamIce pickups (pkg/streamice) -C/\ | | | | |-SHELFICE_WRITE_PICKUP :: Write ShelfIce pickups (pkg/shelfice) -C/\ | | | | |-THSICE_WRITE_PICKUP :: Write ThSIce pickups (see pkg/thsice) -C/\ | | | | |-LAND_WRITE_PICKUP :: Write Land pickups (see pkg/land) -C/\ | | | | |-ATM_PHYS_WRITE_PICKUP :: Write Atm-Phys pickups (pkg/atm_phys) -C/\ | | | | |-FIZHI_WRITE_PICKUP :: Write Fizhi pickups (see pkg/fizhi) -C/\ | | | | |-FIZHI_WRITE_VEGTILES :: Write Fizhi VegTiles (see pkg/fizhi) -C/\ | | | | |-FIZHI_WRITE_DATETIME :: Write Fizhi DateTime (see pkg/fizhi) -C/\ | | | | |-CPL_WRITE_PICKUP :: Write Coupling-Interface pickups -C/\ | | | | |-MYPACKAGE_WRITE_PICKUP :: Write pkg/mypackage pickups -C/\ | | | | -C/\ | | | |-WRITE_PICKUP :: Write main model pickup files. -C/\ | | | -C/\ | | |-AUTODIFF_INADMODE_SET :: Set/reset some adjoint flags -C | | -C<===|=| ************************** -C<===|=| END MAIN TIMESTEPPING LOOP -C<===|=| ************************** -C | | -C | |-COST_AVERAGESFIELDS :: Time-averaged Cost function terms (see pkg/cost) -C | |-PROFILES_INLOOP :: ( see pkg/profiles ) -C | |-COST_FINAL :: Cost function package (see pkg/cost) -C | -C |-CTRL_PACK :: Control vector support package (see pkg/ctrl) -C | -C |-GRDCHK_MAIN :: Gradient check package (see pkg/grdchk) -C | -C |-TIMER_PRINTALL :: Computational timing summary -C | -C |-COMM_STATS :: Summarise inter-proc and inter-thread communication -C | :: events. -C \ev -C -CEOI - #include "PACKAGES_CONFIG.h" #include "CPP_OPTIONS.h" #include "AD_CONFIG.h" @@ -534,22 +23,9 @@ SUBROUTINE THE_MODEL_MAIN(myThid) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE THE_MODEL_MAIN -C | o Master controlling routine for model using the MITgcm -C | UV parallel wrapper. -C *==========================================================* -C | THE_MODEL_MAIN is invoked by the MITgcm UV parallel -C | wrapper with a single integer argument "myThid". This -C | variable identifies the thread number of an instance of -C | THE_MODEL_MAIN. Each instance of THE_MODEL_MAIN works -C | on a particular region of the models domain and -C | synchronises with other instances as necessary. The -C | routine has to "understand" the MITgcm parallel -C | environment and the numerical algorithm. Editing this -C | routine is best done with some knowledge of both aspects. -C | Notes -C | ===== -C | C*P* comments indicating place holders for which code is -C | presently being developed. +C | o This is the OpenAD local version of S/R THE_MODEL_MAIN +C | see ref. version: model/src/the_model_main.F +C | for details about what this routine does. C *==========================================================* C \ev @@ -620,24 +96,20 @@ SUBROUTINE THE_MODEL_MAIN(myThid) C myIter :: Iteration counter for this thread INTEGER myIter _RL myTime - LOGICAL exst + LOGICAL costFinalExist LOGICAL lastdiva C -->> OpenAD _RL foo(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) - _RL foo2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) +c _RL foo2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) CHARACTER*(10) suff CHARACTER*(MAX_LEN_FNAM) fname -C Temprarily change precision to agree with ctrlprec - INTEGER tmpprec - INTEGER ik, il -#ifdef OAD_DEBUG - INTEGER i1, i2, i3, i4, i5 -#endif + INTEGER il +c INTEGER ik C <<-- OpenAD CEOP C-- set default: - exst = .TRUE. + costFinalExist = .TRUE. lastdiva = .TRUE. C -->> OpenAD C- Set the execution mode @@ -690,19 +162,19 @@ SUBROUTINE THE_MODEL_MAIN(myThid) #elif ( defined (ALLOW_AUTODIFF)) # ifdef ALLOW_CTRL -# ifndef EXCLUDE_CTRL_PACK - IF (useCTRL) THEN - INQUIRE( file='costfinal', exist=exst ) - IF ( .NOT. exst ) THEN - IF ( (optimcycle.NE.0 .OR. .NOT.doinitxx) - & .AND. doMainUnpack ) THEN - CALL TIMER_START('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) - CALL CTRL_UNPACK( .TRUE. , myThid ) - CALL TIMER_STOP ('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) - ENDIF - ENDIF - ENDIF + IF ( useCTRL ) THEN +# ifndef EXCLUDE_CTRL_PACK + INQUIRE( file='costfinal', exist=costFinalExist ) + IF ( .NOT. costFinalExist ) THEN + IF ( (optimcycle.NE.0 .OR. .NOT.doinitxx) + & .AND. doMainUnpack ) THEN + CALL TIMER_START('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) + CALL CTRL_UNPACK( .TRUE. , myThid ) + CALL TIMER_STOP ('CTRL_UNPACK [THE_MODEL_MAIN]',myThid) + ENDIF + ENDIF # endif /* EXCLUDE_CTRL_PACK */ + ENDIF # endif /* ALLOW_CTRL */ # ifdef ALLOW_COST @@ -721,26 +193,7 @@ SUBROUTINE THE_MODEL_MAIN(myThid) # elif defined( ALLOW_ADJOINT_RUN ) # ifdef ALLOW_DIVIDED_ADJOINT -C-- The following assumes the TAF option '-pure' - INQUIRE( file='costfinal', exist=exst ) - IF ( .NOT. exst) THEN -# ifdef ALLOW_DEBUG - IF (debugMode) CALL DEBUG_CALL('MDTHE_MAIN_LOOP',myThid) -# endif - CALL TIMER_START('MDTHE_MAIN_LOOP [MD RUN]', myThid) - CALL MDTHE_MAIN_LOOP ( myTime, myIter, myThid ) - CALL TIMER_STOP ('MDTHE_MAIN_LOOP [MD RUN]', myThid) - CALL COST_FINAL_STORE ( myThid, lastdiva ) - ELSE -# ifdef ALLOW_DEBUG - IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid) -# endif - CALL TIMER_START('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) - CALL ADTHE_MAIN_LOOP ( myThid ) - CALL TIMER_STOP ('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid) - CALL COST_FINAL_RESTORE ( myThid, lastdiva ) - ENDIF - + STOP 'In (OpenAD) THE_MODEL_MAIN: ALLOW_DIVIDED_ADJOINT not coded' # else /* ALLOW_DIVIDED_ADJOINT undef */ # ifndef ALLOW_OPENAD # ifdef ALLOW_DEBUG @@ -777,17 +230,13 @@ SUBROUTINE THE_MODEL_MAIN(myThid) our_rev_mode%plain=.TRUE. our_rev_mode%tape=.FALSE. our_rev_mode%adjoint=.FALSE. -C Temporarily change setting of writeBinaryPrec - tmpprec = writeBinaryPrec - writeBinaryPrec = ctrlprec WRITE(suff,'(I10.10)') optimcycle # ifndef ALLOW_OPENAD_ACTIVE_READ_XYZ # ifdef ALLOW_DIFFKR_CONTROL foo=diffkr%d il=ILNBLNK( xx_diffkr_file ) - write(fname(1:MAX_LEN_FNAM),'(3a)') - & 'ad',xx_diffkr_file(1:il),'.' - CALL WRITE_FLD_XYZ_RL(fname,suff,foo,myIter,1) + write(fname,'(4a)') 'ad', xx_diffkr_file(1:il), '.', suff + CALL WRITE_REC_3D_RL(fname,ctrlprec,Nr,foo,1,myIter,myThid) # endif # endif /* ALLOW_OPENAD_ACTIVE_READ_XYZ */ @@ -812,8 +261,6 @@ SUBROUTINE THE_MODEL_MAIN(myThid) cc call write_fld_xyz_rl(fname,suff,foo,myIter,1) cc enddo cc# endif -C Change back to original writeBinaryPrec - writeBinaryPrec = tmpprec our_rev_mode%plain=.TRUE. our_rev_mode%tape=.FALSE. our_rev_mode%adjoint=.FALSE. @@ -842,27 +289,25 @@ SUBROUTINE THE_MODEL_MAIN(myThid) cph-- after final adjoint step myIter=nIter0 # endif - IF (useCTRL) THEN - IF ( lastdiva .AND. doMainPack ) THEN - CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) - CALL CTRL_PACK( .FALSE. , myThid ) - CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) - IF ( ( optimcycle.EQ.0 .OR. (.NOT. doMainUnpack) ) - & .AND. myIter.EQ.nIter0 ) THEN - CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) - CALL CTRL_PACK( .TRUE. , myThid ) - CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) - ENDIF - ENDIF + IF ( useCTRL .AND. lastdiva .AND. doMainPack ) THEN + CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) + CALL CTRL_PACK( .FALSE. , myThid ) + CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) + IF ( ( optimcycle.EQ.0 .OR. (.NOT. doMainUnpack) ) + & .AND. myIter.EQ.nIter0 ) THEN + CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid) + CALL CTRL_PACK( .TRUE. , myThid ) + CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid) + ENDIF ENDIF # endif /* EXCLUDE_CTRL_PACK */ # endif /* ALLOW_CTRL */ # ifdef ALLOW_GRDCHK IF ( useGrdchk .AND. lastdiva ) THEN - CALL TIMER_START('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) - CALL GRDCHK_MAIN( myThid ) - CALL TIMER_STOP ('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) + CALL TIMER_START('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) + CALL GRDCHK_MAIN( myThid ) + CALL TIMER_STOP ('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid) ENDIF # endif @@ -896,8 +341,8 @@ SUBROUTINE THE_MODEL_MAIN(myThid) C-- Write timer statistics IF ( myThid .EQ. 1 ) THEN - CALL TIMER_PRINTALL( myThid ) - CALL COMM_STATS + CALL TIMER_PRINTALL( myThid ) + CALL COMM_STATS ENDIF C-- Check threads synchronization : diff --git a/verification/lab_sea/code_ad/AUTODIFF_OPTIONS.h b/verification/lab_sea/code_ad/AUTODIFF_OPTIONS.h index 818fdb6b4..a1e04dcc0 100644 --- a/verification/lab_sea/code_ad/AUTODIFF_OPTIONS.h +++ b/verification/lab_sea/code_ad/AUTODIFF_OPTIONS.h @@ -38,7 +38,7 @@ C >>> Checkpointing as handled by TAMC C >>> Extract adjoint state #define ALLOW_AUTODIFF_MONITOR C >>> and DYNVARS_DIAG adjoint state -#undef ALLOW_AUTODIFF_MONITOR_DIAG +#define ALLOW_AUTODIFF_MONITOR_DIAG C >>> DO 2-level checkpointing instead of 3-level #undef AUTODIFF_2_LEVEL_CHECKPOINT diff --git a/verification/lab_sea/code_ad/DIAGNOSTICS_SIZE.h b/verification/lab_sea/code_ad/DIAGNOSTICS_SIZE.h index 1d13bed79..13a8d74bb 100644 --- a/verification/lab_sea/code_ad/DIAGNOSTICS_SIZE.h +++ b/verification/lab_sea/code_ad/DIAGNOSTICS_SIZE.h @@ -4,24 +4,24 @@ C ndiagMax :: maximum total number of available diagnostics C numlists :: maximum number of diagnostics list (in data.diagnostics) C numperlist :: maximum number of active diagnostics per list (data.diagnostics) C numLevels :: maximum number of levels to write (data.diagnostics) -C numdiags :: maximum size of the storage array for active 2D/3D diagnostics +C numDiags :: maximum size of the storage array for active 2D/3D diagnostics C nRegions :: maximum number of regions (statistics-diagnostics) +C sizRegMsk :: maximum size of the regional-mask (statistics-diagnostics) C nStats :: maximum number of statistics (e.g.: aver,min,max ...) C diagSt_size:: maximum size of the storage array for statistics-diagnostics -C Note : may need to increase "numdiags" when using several 2D/3D diagnostics, +C Note : may need to increase "numDiags" when using several 2D/3D diagnostics, C and "diagSt_size" (statistics-diags) since values here are deliberately small. INTEGER ndiagMax INTEGER numlists, numperlist, numLevels - INTEGER numdiags - INTEGER nRegions, nStats + INTEGER numDiags + INTEGER nRegions, sizRegMsk, nStats INTEGER diagSt_size PARAMETER( ndiagMax = 500 ) - PARAMETER( numlists = 30, numperlist = 50, numLevels=2*Nr ) - PARAMETER( numdiags = 20*Nr ) - PARAMETER( nRegions = 0 , nStats = 4 ) + PARAMETER( numlists = 10, numperlist = 50, numLevels=2*Nr ) + PARAMETER( numDiags = 20*Nr ) + PARAMETER( nRegions = 0 , sizRegMsk = 1 , nStats = 4 ) PARAMETER( diagSt_size = 10*Nr ) - CEH3 ;;; Local Variables: *** CEH3 ;;; mode:fortran *** CEH3 ;;; End: *** diff --git a/verification/lab_sea/input_ad.noseaice/data.diagnostics b/verification/lab_sea/input_ad.noseaice/data.diagnostics new file mode 100644 index 000000000..eaf622f8c --- /dev/null +++ b/verification/lab_sea/input_ad.noseaice/data.diagnostics @@ -0,0 +1,73 @@ +# Diagnostic Package Choices +#-------------------- +# dumpAtLast (logical): always write output at the end of simulation (default=F) +# diag_mnc (logical): write to NetCDF files (default=useMNC) +#--for each output-stream: +# fileName(n) : prefix of the output file name (max 80c long) for outp.stream n +# frequency(n):< 0 : write snap-shot output every |frequency| seconds +# > 0 : write time-average output every frequency seconds +# timePhase(n) : write at time = timePhase + multiple of |frequency| +# averagingFreq : frequency (in s) for periodic averaging interval +# averagingPhase : phase (in s) for periodic averaging interval +# repeatCycle : number of averaging intervals in 1 cycle +# levels(:,n) : list of levels to write to file (Notes: declared as REAL) +# when this entry is missing, select all common levels of this list +# fields(:,n) : list of selected diagnostics fields (8.c) in outp.stream n +# (see "available_diagnostics.log" file for the full list of diags) +# missing_value(n) : missing value for real-type fields in output file "n" +# fileFlags(n) : specific code (8c string) for output file "n" +#-------------------- + &DIAGNOSTICS_LIST +# dumpAtLast = .TRUE., + diag_mnc = .FALSE., + diag_dBugLevel = 3, +#-- + fields(1:12,1) = 'ETAN ','ETANSQ ','DETADT2 ', + 'oceTAUX ','oceTAUY ','TFLUX ','SFLUX ','oceFreez', + 'TRELAX ','SRELAX ', + levels(1,1) = 1., + fileName(1) = 'surfDiag', + frequency(1) = 21600., + + fields(1:3,2) = 'UVEL ', + 'THETA ','SALT ', +# do not specify levels => all levels are selected + fileName(2) = 'dynDiag', + frequency(2) = 21600., + +#- With DIVA missing diagnostics-pickup, will loose some time-step +# in averaged output if frequency does not divide nchklev_1*nchklev_2*deltaT + fields(1:5,3) = 'ADJuvel ','ADJvvel ','ADJwvel ', + 'ADJtheta','ADJsalt ', + fileName(3) = 'adjDiag', + frequency(3) = 21600., + + fields(1:5,4) = 'ADJetan ','ADJqnet ','ADJempmr', + 'ADJtaux ','ADJtauy ', + fileName(4) = 'adjDiagSurf', + frequency(4) = 14400., + & + +#-------------------- +# Parameter for Diagnostics of per level statistics: +#-------------------- +# diagSt_mnc (logical): write stat-diags to NetCDF files (default=diag_mnc) +# diagSt_regMaskFile : file containing the region-mask to read-in +# nSetRegMskFile : number of region-mask sets within the region-mask file +# set_regMask(i) : region-mask set-index that identifies the region "i" +# val_regMask(i) : region "i" identifier value in the region mask +#--for each output-stream: +# stat_fName(n) : prefix of the output file name (max 80c long) for outp.stream n +# stat_freq(n):< 0 : write snap-shot output every |stat_freq| seconds +# > 0 : write time-average output every stat_freq seconds +# stat_phase(n) : write at time = stat_phase + multiple of |stat_freq| +# stat_region(:,n) : list of "regions" (default: 1 region only=global) +# stat_fields(:,n) : list of selected diagnostics fields (8.c) in outp.stream n +# (see "available_diagnostics.log" file for the full list of diags) +#-------------------- + &DIAG_STATIS_PARMS + stat_fields(1:5,1) = 'ETAN ','UVEL ','VVEL ','WVEL ', 'THETA ', + stat_fName(1) = 'dynStDiag', + stat_freq(1) = 10800., + stat_phase(1) = 0., + & diff --git a/verification/lab_sea/input_ad.noseaice/data.pkg b/verification/lab_sea/input_ad.noseaice/data.pkg index ba3a2d67e..095f1faf4 100644 --- a/verification/lab_sea/input_ad.noseaice/data.pkg +++ b/verification/lab_sea/input_ad.noseaice/data.pkg @@ -4,7 +4,7 @@ useKPP = .TRUE., useEXF = .TRUE., useSEAICE = .FALSE., - useDiagnostics = .FALSE., + useDiagnostics = .TRUE., useMNC = .TRUE., useECCO = .TRUE., useGrdchk = .TRUE., diff --git a/verification/lab_sea/input_ad/do_run.sh b/verification/lab_sea/input_ad/do_run.sh index ada512e5f..8acb633fa 100755 --- a/verification/lab_sea/input_ad/do_run.sh +++ b/verification/lab_sea/input_ad/do_run.sh @@ -19,20 +19,38 @@ if test $# = 0 ; then #- not MPI run: echo "Run $add_DIVA_runs times + final run:" for ii in `seq 0 $extraRuns` ; do + echo " --> starts DIVA run # $ii :" ./mitgcmuv_ad > output_adm.txt.diva_${ii} - echo " additional DIVA run # $ii : done" + echo -n " <-- DIVA run # $ii : done" + if test -f divided.ctrl ; then + echo -n ", divided.ctrl :" ; cat divided.ctrl + else echo ", no 'divided.ctrl' file" ; fi +# if test $ii = 2 ; then exit $ii ; fi done + echo " --> Final DIVA run :" ./mitgcmuv_ad > output_adm.txt + echo -n " <-- Final run : done" + if test -f divided.ctrl ; then echo -n ", divided.ctrl :" ; cat divided.ctrl + else echo "" ; fi else if [ $1 -ge 1 ] ; then rm -f costfunction*0000 costfinal divided.ctrl snapshot* #- MPI run on $1 procs (note: may need to edit mpirun command): echo "Run $add_DIVA_runs times + final run (use 'mpirun -np $1' ):" for ii in `seq 0 $extraRuns` ; do + echo " --> starts DIVA run # $ii :" mpirun -np $1 ./mitgcmuv_ad - echo " additional DIVA run # $ii : done" + echo -n " <-- DIVA run # $ii : done" mv -f STDOUT.0000 STDOUT.0000.diva_${ii} + if test -f divided.ctrl ; then + echo ", divided.ctrl :" + cat divided.ctrl + else echo ", no 'divided.ctrl' file" ; fi done + echo " --> Final DIVA run :" mpirun -np $1 ./mitgcmuv_ad + echo -n " <-- Final run : done" + if test -f divided.ctrl ; then echo ", divided.ctrl :" ; cat divided.ctrl + else echo "" ; fi fi fi