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