tools/OAD_support/ad_template.revolve.F

9f3ad1881a Patr*0001 #include "PACKAGES_CONFIG.h"
279dc77b07 Patr*0002 #include "OPENAD_OPTIONS.h"
9f3ad1881a Patr*0003
b6f3d01b24 Jean*0004       subroutine template()
                0005       use OAD_cp
                0006       use OAD_tape
                0007       use OAD_rev
                0008       use revolve
                0009
                0010 c we may need these for the checkpointing
                0011       use SIZE_mod
                0012       use EEPARAMS_mod
                0013       use PARAMS_mod
                0014       use BAR2_mod
                0015       use BARRIER_mod
9f3ad1881a Patr*0016 #ifdef ALLOW_CD_CODE
b6f3d01b24 Jean*0017       use CD_CODE_VARS_mod
9f3ad1881a Patr*0018 #endif
b6f3d01b24 Jean*0019       use CG2D_mod
                0020       use CG3D_mod
                0021       use DYNVARS_mod
                0022       use EESUPPORT_mod
                0023       use EOS_mod
                0024       use EXCH_mod
                0025       use FC_NAMEMANGLE_mod
                0026       use FFIELDS_mod
334c9de798 Jean*0027 #ifdef ALLOW_GENERIC_ADVDIFF
b6f3d01b24 Jean*0028       use GAD_mod
334c9de798 Jean*0029 #endif
b6f3d01b24 Jean*0030       use GLOBAL_MAX_mod
                0031       use GLOBAL_SUM_mod
e22615ff1f Patr*0032 #ifdef ALLOW_GGL90
                0033       use GGL90_mod
                0034 #endif
9f3ad1881a Patr*0035 #ifdef ALLOW_GMREDI
b6f3d01b24 Jean*0036       use GMREDI_mod
9f3ad1881a Patr*0037 #endif
b6f3d01b24 Jean*0038       use GRID_mod
71108ddfe4 Patr*0039 #ifdef ALLOW_KPP
                0040       use KPP_mod
                0041       use KPP_PARAMS_mod
                0042 #endif
334c9de798 Jean*0043 #ifdef ALLOW_MOM_COMMON
9f3ad1881a Patr*0044       use MOM_VISC_mod
334c9de798 Jean*0045 #endif
b6f3d01b24 Jean*0046       use MPI_INFO_mod
9f3ad1881a Patr*0047 #ifdef ALLOW_SHAP_FILT
                0048       use SHAP_FILT_mod
                0049 #endif
cdf60b9aad Patr*0050 #ifdef ALLOW_STREAMICE
                0051       use STREAMICE_mod
                0052       use STREAMICE_ADV_mod
                0053       use STREAMICE_BDRY_mod
                0054       use STREAMICE_CG_mod
                0055 #endif
b6f3d01b24 Jean*0056       use SURFACE_mod
                0057       use cost_mod
                0058       use g_cost_mod
4d72283393 Mart*0059       use CTRL_mod
edcd27be69 Mart*0060       use CTRL_DUMMY_mod
65754df434 Mart*0061       use OPTIMCYCLE_mod
444da61630 Mart*0062       use GRDCHK_mod
7c50f07931 Mart*0063
b6f3d01b24 Jean*0064 !$TEMPLATE_PRAGMA_DECLARATIONS
                0065       LOGICAL :: initialized=.FALSE.
                0066       TYPE(rvAction),save :: theAction
9674a72dd0 Jean*0067       CHARACTER(80) :: errorMsg
b6f3d01b24 Jean*0068       integer, save :: jointCPCount
                0069       integer, save :: currIter
                0070
                0071       integer :: cp_loop_variable_1,cp_loop_variable_2,
                0072      +     cp_loop_variable_3,cp_loop_variable_4,cp_loop_variable_5
                0073
                0074       type(modeType) :: our_orig_mode
                0075
                0076       integer iaddr
                0077       external iaddr
                0078
                0079 #ifdef OAD_DEBUG_JOINT
                0080       character*(80):: indentation='
                0081      +                                         '
                0082       our_indent=our_indent+1
                0083
7c50f07931 Mart*0084       write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
b6f3d01b24 Jean*0085      +'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
                0086       call oad_dump_revmod(); call oad_dump_tapestats()
7c50f07931 Mart*0087       write(standardmessageunit,*)
b6f3d01b24 Jean*0088 #endif
                0089
                0090       nIter0 = NINT( (startTime-baseTime)/deltaTClock )
7c50f07931 Mart*0091       if (our_rev_mode%arg_store) then
75c5b64bda Jean*0092         call cp_write_open()
b6f3d01b24 Jean*0093 #ifdef OAD_DEBUG_JOINT
7c50f07931 Mart*0094          write(standardmessageunit,'(A,A,A)')
                0095      +'OAD:',indentation(1:our_indent),
b6f3d01b24 Jean*0096      +' __SRNAME__: entering arg store'
                0097 #endif
                0098 !$PLACEHOLDER_PRAGMA$ id=8
                0099        call cp_close()
7c50f07931 Mart*0100       end if
b6f3d01b24 Jean*0101       if (our_rev_mode%arg_restore) then
                0102 #ifdef OAD_DEBUG_JOINT
7c50f07931 Mart*0103          write(standardmessageunit,'(A,A,A)')
                0104      +'OAD:',indentation(1:our_indent),
b6f3d01b24 Jean*0105      +' __SRNAME__: entering arg restore'
                0106 #endif
75c5b64bda Jean*0107         call cp_read_open()
b6f3d01b24 Jean*0108 !$PLACEHOLDER_PRAGMA$ id=9
75c5b64bda Jean*0109         call cp_close()
b6f3d01b24 Jean*0110       end if
                0111       if (our_rev_mode%plain) then
                0112 #ifdef OAD_DEBUG_JOINT
7c50f07931 Mart*0113          write(standardmessageunit,'(A,A,A)')
                0114      +'OAD:',indentation(1:our_indent),
b6f3d01b24 Jean*0115      +' __SRNAME__: run plain, down plain'
                0116 #endif
279dc77b07 Patr*0117 #ifdef ALLOW_OPENAD_DIVA
                0118       DO iloop1 = 1, nTimeSteps
                0119         PROD = (ILOOP1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
                0120         print *, 'DIVA Revolve Plain PROD = ', PROD
                0121         CALL OpenAD_forward_step( PROD, mytime, myiter, mythid )
                0122       enddo
7c50f07931 Mart*0123 #else
b6f3d01b24 Jean*0124       DO iloop = 1, nTimeSteps
                0125         CALL OpenAD_forward_step( iloop, mytime, myiter, mythid )
                0126       enddo
279dc77b07 Patr*0127 #endif
b6f3d01b24 Jean*0128       end if
                0129       if (our_rev_mode%tape) then
                0130 #ifdef OAD_DEBUG_JOINT
7c50f07931 Mart*0131          write(standardmessageunit,'(A,A,A)')
                0132      +'OAD:',indentation(1:our_indent),
b6f3d01b24 Jean*0133      +' __SRNAME__: run tape, down revolve until first U turn'
                0134 #endif
                0135          currIter=0
                0136          jointCPcount=cp_fNumber()
                0137          initialized=rvInit(nTimeSteps,120,
                0138      +                      errorMsg,theAction)
                0139          IF (.NOT.initialized) WRITE(*,'(A,A)') 'Error: ', errorMsg
                0140          do while (theAction%actionFlag/=rvDone)
                0141            theAction=rvNextAction()
7c50f07931 Mart*0142            select case (theAction%actionFlag)
b6f3d01b24 Jean*0143              case (rvStore)
                0144                 call cp_write_open(theAction%cpNum+jointCPCount)
                0145 !$PLACEHOLDER_PRAGMA$ id=8
                0146                 call cp_close
                0147              case (rvForward)
                0148                 call OAD_revPlain
                0149                 do currIter=currIter,theAction%iteration-1
7c50f07931 Mart*0150 #ifdef ALLOW_OPENAD_DIVA
279dc77b07 Patr*0151                    PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
                0152                    print *, 'DIVA Revolve Tape rvForward PROD = ', PROD
7c50f07931 Mart*0153                    CALL OpenAD_forward_step( PROD, mytime,
b6f3d01b24 Jean*0154      +myiter, mythid )
279dc77b07 Patr*0155 #else
                0156                    CALL OpenAD_forward_step( currIter+1, mytime,
7c50f07931 Mart*0157      +myiter, mythid )
279dc77b07 Patr*0158 #endif
b6f3d01b24 Jean*0159                 end do
                0160                 call OAD_revTape
                0161              case (rvFirstUTurn)
7c50f07931 Mart*0162 #ifdef ALLOW_OPENAD_DIVA
279dc77b07 Patr*0163                 PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
                0164                 print *, 'DIVA Revolve Tape rvFirstUTurn PROD = ', PROD
7c50f07931 Mart*0165                 CALL OpenAD_forward_step( PROD, mytime, myiter,
279dc77b07 Patr*0166      +mythid )
                0167 #else
                0168                 CALL OpenAD_forward_step( currIter+1, mytime, myiter,
b6f3d01b24 Jean*0169      +mythid )
279dc77b07 Patr*0170 #endif
b6f3d01b24 Jean*0171 ! get out now ...
7c50f07931 Mart*0172                 exit
                0173              end select
b6f3d01b24 Jean*0174           end do
7c50f07931 Mart*0175       end if
b6f3d01b24 Jean*0176       if (our_rev_mode%adjoint) then
                0177         IF (.NOT.initialized) WRITE(*,'(A)') 'Error: not initialized'
                0178         do while (theAction%actionFlag/=rvDone)
7c50f07931 Mart*0179            select case (theAction%actionFlag)
b6f3d01b24 Jean*0180              case (rvFirstUTurn)
                0181 !we taped already ... see above
7c50f07931 Mart*0182 #ifdef ALLOW_OPENAD_DIVA
                0183                 PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
279dc77b07 Patr*0184                 print *, 'DIVA Revolve Adjoint rvFirstUTurn PROD = ', PROD
7c50f07931 Mart*0185                 CALL OpenAD_forward_step( PROD, mytime, myiter,
279dc77b07 Patr*0186      +mythid )
                0187 #else
7c50f07931 Mart*0188                 CALL OpenAD_forward_step( currIter+1, mytime, myiter,
b6f3d01b24 Jean*0189      +mythid )
279dc77b07 Patr*0190 #endif
b6f3d01b24 Jean*0191              case (rvStore)
                0192                 call cp_write_open(theAction%cpNum+jointCPCount)
                0193 !$PLACEHOLDER_PRAGMA$ id=8
                0194                 call cp_close
                0195              case (rvRestore)
                0196                 call cp_read_open(theAction%cpNum+jointCPCount)
                0197 !$PLACEHOLDER_PRAGMA$ id=9
                0198                 currIter=theAction%iteration
                0199                 call cp_close
                0200              case (rvForward)
                0201                 call OAD_revPlain
                0202                 do currIter=currIter,theAction%iteration-1
279dc77b07 Patr*0203 #ifdef ALLOW_OPENAD_DIVA
                0204                    PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
75c5b64bda Jean*0205                    print *, 'DIVA Revolve Adjoint rvForward PROD = ', PROD
279dc77b07 Patr*0206                    CALL OpenAD_forward_step( PROD, mytime, myiter,
                0207      + mythid )
                0208 #else
b6f3d01b24 Jean*0209                    CALL OpenAD_forward_step( currIter+1, mytime, myiter,
                0210      + mythid )
279dc77b07 Patr*0211 #endif
b6f3d01b24 Jean*0212                 end do
                0213                 call OAD_revAdjoint
                0214              case (rvUTurn)
279dc77b07 Patr*0215 #ifdef ALLOW_OPENAD_DIVA
7c50f07931 Mart*0216                 PROD = (currIter+1 + NTIMESTEPS_L2 *(ILOOP +(-1)))
279dc77b07 Patr*0217 #endif
b6f3d01b24 Jean*0218                 call OAD_revTape
279dc77b07 Patr*0219 #ifdef ALLOW_OPENAD_DIVA
75c5b64bda Jean*0220                 print *, 'DIVA Revolve Adjoint rvUTurn tp PROD = ', PROD
7c50f07931 Mart*0221                 CALL OpenAD_forward_step( PROD, mytime, myiter,
279dc77b07 Patr*0222      +mythid )
                0223 #else
                0224                 CALL OpenAD_forward_step( currIter+1, mytime, myiter,
b6f3d01b24 Jean*0225      +mythid )
279dc77b07 Patr*0226 #endif
b6f3d01b24 Jean*0227                 call OAD_revAdjoint
279dc77b07 Patr*0228 #ifdef ALLOW_OPENAD_DIVA
75c5b64bda Jean*0229                 print *, 'DIVA Revolve Adjoint rvUTurn ad PROD = ', PROD
7c50f07931 Mart*0230                 CALL OpenAD_forward_step( PROD, mytime, myiter,
b6f3d01b24 Jean*0231      +mythid )
279dc77b07 Patr*0232 #else
                0233                 CALL OpenAD_forward_step( currIter+1, mytime, myiter,
                0234      +mythid )
                0235 #endif
7c50f07931 Mart*0236            end select
b6f3d01b24 Jean*0237            theAction=rvNextAction()
                0238         end do
7c50f07931 Mart*0239       end if
b6f3d01b24 Jean*0240
                0241 #ifdef OAD_DEBUG_JOINT
7c50f07931 Mart*0242       write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
b6f3d01b24 Jean*0243      +'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
                0244       call oad_dump_revmod(); call oad_dump_tapestats()
7c50f07931 Mart*0245       write(standardmessageunit,*)
b6f3d01b24 Jean*0246
                0247       our_indent=our_indent-1
                0248 #endif
                0249
                0250       end subroutine template