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