tools/OAD_support/ad_template.streamice_vel_phistage.F

0fbff46b46 dngo*0001 #include "STREAMICE_OPTIONS.h"
                0002
                0003       subroutine template()
                0004       use OAD_cp
                0005       use OAD_tape
                0006       use OAD_rev
                0007
                0008 !$TEMPLATE_PRAGMA_DECLARATIONS
                0009
                0010       integer myi
                0011 ! Temporaries to hold the stack pointers
                0012       integer temp_double_tape_pointer, temp_integer_tape_pointer, temp_logical_tape_pointer, temp_character_tape_pointer, temp_string_tape_pointer
                0013       type(modeType) :: our_orig_mode
                0014
                0015       integer iaddr
                0016       external iaddr
                0017 !<------------------Begin user declarations ---------------------->!
                0018 ! Insert declarations of dummy variables for calling adjoint computation
                0019 ! without side effects, and storing adjoint variable iterates
                0020
                0021       real*8 adj_fp_err_change
                0022
                0023 #if (defined (ALLOW_OPENAD) && defined (ALLOW_STREAMICE_OAD_FP))
                0024
                0025 #ifdef STREAMICE_ALLOW_FRIC_CONTROL
                0026       Real*8 C_basal_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0027 #endif
                0028 #ifdef STREAMICE_ALLOW_BGLEN_CONTROL
                0029       Real*8 B_glen_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0030 #endif
                0031 #ifdef STREAMICE_ALLOW_DEPTH_CONTROL
                0032       Real*8 R_low_si_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0033 #endif
                0034       Real*8 H_streamice_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0035       Real*8 taudx_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0036       Real*8 taudy_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0037       Real*8 u_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0038       Real*8 v_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0039       Real*8 u_new_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0040       Real*8 v_new_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0041 #ifdef STREAMICE_HYBRID_STRESS
                0042       Real*8 taubx_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0043       Real*8 tauby_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0044       Real*8 visc_full_dummy_d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0045       Real*8 taubx_new_dummy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0046       Real*8 tauby_new_dummy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0047       Real*8 visc_new_dummy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0048 #endif
                0049
                0050 !<------------------End user declarations ------------------------>!
                0051       if (our_rev_mode%plain) then
                0052       our_orig_mode=our_rev_mode
                0053       IF(ISINLOOP .eq. 0) THEN
                0054         CONVERGED = .FALSE.
                0055         ADJ_CONVERGED = .FALSE.
                0056         !ERR_LAST_CHANGE = 10.
                0057       end if
                0058       IF(ISINLOOP .ne. 0) THEN
                0059         IF(.NOT. CONVERGED) THEN
                0060           NL_ITER = (NL_ITER + 1)
                0061           CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL
                0062      +,CG_ITERS,err_max)
                0063
                0064           WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice linear solve number',
                0065      +NL_ITER,' ',CG_ITERS,' iterations '
                0066
                0067           CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',1)
                0068
                0069 !!!!!!!!!!!! conv check
                0070
                0071           if (STREAMICE_chkresidconvergence) then
                0072
                0073            WRITE(msgBuf,'(A,E15.7)') 'err/err_init',
                0074      &                       err_max/err_init
                0075            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0076      &                    SQUEEZE_RIGHT , 1)
                0077
                0078            IF (err_max .LE. streamice_nonlin_tol * err_init) THEN
                0079             CONVERGED = .true.
                0080            ENDIF
                0081
                0082            IF (err_max<err_last_change*1.e-2 .and.
                0083      &      STREAMICE_lower_cg_tol) THEN
                0084             cgtol = cgtol * 5.e-2
                0085             err_last_change = err_max
                0086             WRITE(msgBuf,'(A,E15.7)') 'new cg tol: ',
                0087      &                       cgtol
                0088             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0089      &                    SQUEEZE_RIGHT , 1)
                0090            ENDIF
                0091
                0092           endif
                0093
                0094           if (STREAMICE_chkfixedptconvergence) then
                0095
                0096            CALL openad_STREAMICE_GET_FP_ERR_OAD ( err_max_fp, myThid )
                0097
                0098            WRITE(msgBuf,'(A,1PE22.14)') 'STREAMICE_FP_ERROR =',
                0099      &                       err_max_fp
                0100            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0101      &                    SQUEEZE_RIGHT , 1)
                0102
                0103            IF (err_max_fp .LE. streamice_nonlin_tol_fp) THEN
                0104             CONVERGED = .true.
                0105            ENDIF
                0106
                0107           endif
                0108
                0109           DO bj = myByLo(myThid), myByHi(myThid)
                0110            DO bi = myBxLo(myThid), myBxHi(myThid)
                0111             DO j=1-OLy,sNy+OLy
                0112              DO i=1-OLx,sNx+OLx
                0113               U_streamice (i,j,bi,bj)=u_new_SI (i,j,bi,bj)
                0114               V_streamice (i,j,bi,bj)=v_new_SI (i,j,bi,bj)
                0115 #ifdef STREAMICE_HYBRID_STRESS
                0116               streamice_taubx(i,j,bi,bj)=taubx_new_si(i,j,bi,bj)
                0117               streamice_tauby(i,j,bi,bj)=tauby_new_si(i,j,bi,bj)
                0118               DO m=Nr,1,-1
                0119                visc_streamice_full(i,j,m,bi,bj)=
                0120      &          visc_full_new_si(i,j,m,bi,bj)
                0121               ENDDO
                0122 #endif
                0123              ENDDO
                0124             ENDDO
                0125            ENDDO
                0126           ENDDO
                0127
                0128 !!!!!!!!!!!! end conv check
                0129
                0130         end if
                0131       end if
                0132
                0133       our_rev_mode=our_orig_mode
                0134       end if
                0135
                0136 !!!!!!!!!!!! TAPE MODE !!!!!!!!!!!!!!
                0137
                0138       if (our_rev_mode%tape) then
                0139       our_orig_mode=our_rev_mode
                0140       if(isinloop.eq.0) then
                0141         CONVERGED = .false.
                0142         nl_iter = 0
                0143       end if
                0144
                0145       if(isinloop.eq.1) then
                0146
                0147         CALL TIMER_START('STREAMICE TAPE FIXED POINT LOOP',myThid)
                0148
                0149         IF (.not. (CONVERGED).AND. nl_iter.lt.MAXNLITER) THEN
                0150           NL_ITER = (NL_ITER+1)
                0151           !Run in plain mode while not converged
                0152           our_rev_mode%plain=.true.
                0153           our_rev_mode%tape=.false.
                0154           our_rev_mode%adjoint=.false.
                0155           CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL
                0156      +,CG_ITERS,err_max)
                0157
                0158 !---- write out number of cg iters
                0159
                0160           WRITE(MSGBUF,'(A,I5,A,I4,A)') 'streamice linear solve number',
                0161      +NL_ITER,' ',CG_ITERS,' iterations '
                0162 !          OAD_CTMP0 = 1
                0163           CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',1)
                0164
                0165 !---- conv check
                0166
                0167           if (STREAMICE_chkresidconvergence) then
                0168
                0169            WRITE(msgBuf,'(A,E15.7)') 'err/err_init',
                0170      &                       err_max/err_init
                0171            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0172      &                    SQUEEZE_RIGHT , 1)
                0173
                0174            IF (err_max .LE. streamice_nonlin_tol * err_init) THEN
                0175             CONVERGED = .true.
                0176            ENDIF
                0177
                0178            IF (err_max<err_last_change*1.e-2 .and.
                0179      &      STREAMICE_lower_cg_tol) THEN
                0180             cgtol = cgtol * 5.e-2
                0181             err_last_change = err_max
                0182             WRITE(msgBuf,'(A,E15.7)') 'new cg tol: ',
                0183      &                       cgtol
                0184             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0185      &                    SQUEEZE_RIGHT , 1)
                0186            ENDIF
                0187
                0188           endif
                0189
                0190           if (STREAMICE_chkfixedptconvergence) then
                0191
                0192            CALL openad_STREAMICE_GET_FP_ERR_OAD ( err_max_fp, myThid )
                0193
                0194            WRITE(msgBuf,'(A,1PE22.14)') 'STREAMICE_FP_ERROR =',
                0195      &                       err_max_fp
                0196            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0197      &                    SQUEEZE_RIGHT , 1)
                0198
                0199            IF (err_max_fp .LE. streamice_nonlin_tol_fp) THEN
                0200             CONVERGED = .true.
                0201            ENDIF
                0202
                0203           endif
                0204
                0205           DO bj = myByLo(myThid), myByHi(myThid)
                0206             DO bi = myBxLo(myThid), myBxHi(myThid)
                0207               DO j=1-OLy,sNy+OLy
                0208                 DO i=1-OLx,sNx+OLx
                0209                   U_streamice (i,j,bi,bj)%v=u_new_SI (i,j,bi,bj)%v
                0210                   V_streamice (i,j,bi,bj)%v=v_new_SI (i,j,bi,bj)%v
                0211 #ifdef STREAMICE_HYBRID_STRESS
                0212                   streamice_taubx(i,j,bi,bj)%v=
                0213      &             taubx_new_si(i,j,bi,bj)%v
                0214                   streamice_tauby(i,j,bi,bj)%v=
                0215      &             tauby_new_si(i,j,bi,bj)%v
                0216                   DO m=Nr,1,-1
                0217                    visc_streamice_full(i,j,m,bi,bj)%v=
                0218      &              visc_full_new_si(i,j,m,bi,bj)%v
                0219                   ENDDO
                0220 #endif
                0221                 ENDDO
                0222               ENDDO
                0223             ENDDO
                0224           ENDDO
                0225
                0226 !--------conv check done
                0227
                0228           if (converged .OR. nl_iter.eq.MAXNLITER) then
                0229             !Run once in tape mode if this is the last time
                0230             our_rev_mode%plain=.false.
                0231             our_rev_mode%tape=.true.
                0232             our_rev_mode%adjoint=.false.
                0233             CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CG
                0234      +TOL,CG_ITERS,err_max)
                0235           end if
                0236         end if
                0237         CALL TIMER_STOP('STREAMICE TAPE FIXED POINT LOOP',myThid)
                0238       end if
                0239       if(isinloop.eq.2 ) then
                0240
                0241         CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL
                0242      +,CG_ITERS,err_max)
                0243
                0244         DO bj = myByLo(myThid), myByHi(myThid)
                0245           DO bi = myBxLo(myThid), myBxHi(myThid)
                0246             DO j=1-OLy,sNy+OLy
                0247               DO i=1-OLx,sNx+OLx
                0248                 U_streamice (i,j,bi,bj)%v=u_new_SI (i,j,bi,bj)%v
                0249                 V_streamice (i,j,bi,bj)%v=v_new_SI (i,j,bi,bj)%v
                0250 #ifdef STREAMICE_HYBRID_STRESS
                0251                   streamice_taubx(i,j,bi,bj)%v=
                0252      &             taubx_new_si(i,j,bi,bj)%v
                0253                   streamice_tauby(i,j,bi,bj)%v=
                0254      &             tauby_new_si(i,j,bi,bj)%v
                0255                   DO m=Nr,1,-1
                0256                    visc_streamice_full(i,j,m,bi,bj)%v=
                0257      &              visc_full_new_si(i,j,m,bi,bj)%v
                0258                   ENDDO
                0259 #endif
                0260               ENDDO
                0261             ENDDO
                0262           ENDDO
                0263         ENDDO
                0264       end if
                0265       our_rev_mode=our_orig_mode
                0266       end if
                0267
                0268 !!!!!!!!!!!! ADJOINT MODE !!!!!!!!!!!!!!
                0269
                0270       if (our_rev_mode%adjoint) then
                0271       our_orig_mode=our_rev_mode
                0272
                0273       if(isinloop.eq.2) then
                0274
                0275         ADJ_CONVERGED = .false.
                0276         adj_iter = 0
                0277
                0278         DO bj = myByLo(myThid), myByHi(myThid)
                0279           DO bi = myBxLo(myThid), myBxHi(myThid)
                0280             DO j=1-OLy,sNy+OLy
                0281               DO i=1-OLx,sNx+OLx
                0282                 v_new_SI (i,j,bi,bj)%d= V_streamice(i,j,bi,bj)%d
                0283                 V_streamice  (i,j,bi,bj)%d = 0.0
                0284                 u_new_SI (i,j,bi,bj)%d= U_streamice(i,j,bi,bj)%d
                0285                 U_streamice  (i,j,bi,bj)%d = 0.0
                0286 #ifdef STREAMICE_HYBRID_STRESS
                0287                 taubx_new_si(i,j,bi,bj)%d=
                0288      &           streamice_taubx(i,j,bi,bj)%d
                0289                 streamice_taubx(i,j,bi,bj)%d = 0.0
                0290                 tauby_new_si(i,j,bi,bj)%d=
                0291      &           streamice_tauby(i,j,bi,bj)%d
                0292                 streamice_tauby(i,j,bi,bj)%d = 0.0
                0293                 DO m=Nr,1,-1
                0294                  visc_full_new_si(i,j,m,bi,bj)%d=
                0295      &            visc_streamice_full(i,j,m,bi,bj)%d
                0296                  visc_streamice_full(i,j,m,bi,bj)%d = 0.0
                0297                 ENDDO
                0298 #endif
                0299               ENDDO
                0300             ENDDO
                0301           ENDDO
                0302         ENDDO
                0303
                0304         CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL
                0305      +,CG_ITERS,err_max)
                0306
                0307         DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1
                0308           DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1
                0309             DO J = 1-OLy,sNy+OLy
                0310               DO I = 1-OLx,sNx+OLx
                0311
                0312                 U_streamice_dvals(I,J,BI,BJ) =
                0313      +U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d
                0314                 V_streamice_dvals(I,J,BI,BJ) =
                0315      +V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d
                0316 #ifdef STREAMICE_HYBRID_STRESS
                0317                 taubx_dvals(I,J,BI,BJ) =
                0318      +streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d
                0319                 tauby_dvals(I,J,BI,BJ) =
                0320      +streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d
                0321                 DO m=Nr,1,-1
                0322                 visc_full_dvals(I,J,m,BI,BJ) =
                0323      +VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d
                0324                 ENDDO
                0325 #endif
                0326
                0327                 U_new_si(I,J,BI,BJ)%d =
                0328      +U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d
                0329                 V_new_si(I,J,BI,BJ)%d =
                0330      +V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d
                0331 #ifdef STREAMICE_HYBRID_STRESS
                0332                 taubx_new_si(I,J,BI,BJ)%d =
                0333      +streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d
                0334                 tauby_new_si(I,J,BI,BJ)%d =
                0335      +streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d
                0336                 DO m=Nr,1,-1
                0337                 visc_full_new_si(I,J,m,BI,BJ)%d =
                0338      +VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d
                0339                 ENDDO
                0340 #endif
                0341
                0342               END DO
                0343             END DO
                0344           END DO
                0345         END DO
                0346
                0347       end if
                0348
                0349       if(isinloop.eq.1) then
                0350         if((.NOT.ADJ_CONVERGED).AND.(adj_iter.lt.MAXNLITER)) then
                0351
                0352           adj_iter = adj_iter + 1
                0353           if (adj_iter.eq.1) then
                0354            CALL TIMER_START('STREAMICE ADJ FIXED POINT LOOP0',myThid)
                0355           else
                0356            CALL TIMER_START('STREAMICE ADJ FIXED POINT LOOP',myThid)
                0357           endif
                0358
                0359           DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1
                0360             DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1
                0361               DO J = 1-OLy,sNy+OLy
                0362                 DO I = 1-OLx,sNx+OLx
                0363
                0364                   U_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) =
                0365      +U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d
                0366                   V_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) =
                0367      +V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d
                0368 #ifdef STREAMICE_HYBRID_STRESS
                0369                   TAUBX_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) =
                0370      +streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d
                0371                   TAUBY_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) =
                0372      +streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d
                0373                   DO m=Nr,1,-1
                0374                    VISC_FULL_DUMMY_D(INT(I),INT(J),m,INT(BI),INT(BJ))=
                0375      +VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d
                0376                   ENDDO
                0377 #endif
                0378
                0379                   U_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) =
                0380      +U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d
                0381                   V_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ)) =
                0382      +V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d
                0383 #ifdef STREAMICE_HYBRID_STRESS
                0384                   TAUBX_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ)) =
                0385      +TAUBX_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d
                0386                   TAUBY_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ)) =
                0387      +TAUBY_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d
                0388                   DO m=Nr,1,-1
                0389                    VISC_new_DUMMY(INT(I),INT(J),m,INT(BI),INT(BJ))=
                0390      +visc_full_new_si(INT(I),INT(J),m,INT(BI),INT(BJ))%d
                0391                   ENDDO
                0392 #endif
                0393
                0394                   U_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0395      +U_streamice_dvals(I,J,BI,BJ)
                0396                   V_STREAMICE(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0397      +V_STREAMICE_dvals(I,J,BI,BJ)
                0398 #ifdef STREAMICE_HYBRID_STRESS
                0399                   streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0400      +taubx_dvals(I,J,BI,BJ)
                0401                   streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0402      +tauby_dvals(I,J,BI,BJ)
                0403                   DO m=Nr,1,-1
                0404               VISC_STREAMICE_FULL(INT(I),INT(J),m,INT(BI),INT(BJ))%d
                0405      +=visc_full_dvals(I,J,m,BI,BJ)
                0406                   ENDDO
                0407 #endif
                0408
                0409 #ifdef STREAMICE_ALLOW_FRIC_CONTROL
                0410                   C_basal_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) =
                0411      +C_basal_friction(INT(I),INT(J),INT(BI),INT(BJ))%d
                0412 #endif
                0413 #ifdef STREAMICE_ALLOW_BGLEN_CONTROL
                0414                   b_glen_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) =
                0415      +B_glen(INT(I),INT(J),INT(BI),INT(BJ))%d
                0416 #endif
                0417 #ifdef STREAMICE_ALLOW_DEPTH_CONTROL
                0418                   R_low_si_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) =
                0419      +R_low_si(INT(I),INT(J),INT(BI),INT(BJ))%d
                0420 #endif
                0421                   H_streamice_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) =
                0422      +H_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d
                0423                   taudx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) =
                0424      +taudx_si(INT(I),INT(J),INT(BI),INT(BJ))%d
                0425                   taudy_dummy_d(INT(I),INT(J),INT(BI),INT(BJ)) =
                0426      +taudy_si(INT(I),INT(J),INT(BI),INT(BJ))%d
                0427
                0428                 END DO
                0429               END DO
                0430             END DO
                0431           END DO
                0432
                0433           !Store the stack pointers
                0434           temp_double_tape_pointer = oad_dt_ptr
                0435           temp_integer_tape_pointer = oad_it_ptr
                0436           temp_logical_tape_pointer = oad_lt_ptr
                0437           temp_string_tape_pointer = oad_st_ptr
                0438
                0439 #ifdef ALLOW_PETSC
                0440           IF (STREAMICE_OAD_petsc_reuse) then
                0441            if (adj_iter.eq.1) then
                0442             STREAMICE_need2createmat=.true.
                0443             STREAMICE_need2destroymat=.false.
                0444             PETSC_PRECOND_TMP = PETSC_PRECOND_TYPE
                0445             PETSC_PRECOND_TYPE = PETSC_PRECOND_OAD
                0446            else
                0447             STREAMICE_need2createmat=.false.
                0448             STREAMICE_need2destroymat=.false.
                0449            endif
                0450           ENDIF
                0451 #endif
                0452
                0453           CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL
                0454      +,CG_ITERS,err_max)
                0455
                0456 #ifdef ALLOW_PETSC
                0457           IF (STREAMICE_OAD_petsc_reuse) then
                0458            if (adj_iter.eq.MAXNLITER) then
                0459             STREAMICE_need2createmat=.true.
                0460             STREAMICE_need2destroymat=.true.
                0461             CALL streamice_petscmatdestroy(myThid)
                0462             PETSC_PRECOND_TYPE = PETSC_PRECOND_TMP
                0463            endif
                0464           ENDIF
                0465 #endif
                0466
                0467           DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1
                0468             DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1
                0469               DO J = 1-OLy,sNy+OLy
                0470                 DO I = 1-OLx,sNx+OLx
                0471
                0472                   U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0473      +U_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ))
                0474                   V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0475      +V_NEW_DUMMY_D(INT(I),INT(J),INT(BI),INT(BJ))
                0476 #ifdef STREAMICE_HYBRID_STRESS
                0477                   TAUBX_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0478      +TAUBX_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ))
                0479                   TAUBY_new_si(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0480      +TAUBY_new_DUMMY(INT(I),INT(J),INT(BI),INT(BJ))
                0481                   DO m=Nr,1,-1
                0482                    visc_full_new_si(INT(I),INT(J),m,INT(BI),INT(BJ))%d=
                0483      +VISC_new_DUMMY(INT(I),INT(J),m,INT(BI),INT(BJ))
                0484                   ENDDO
                0485 #endif
                0486
                0487                 END DO
                0488               END DO
                0489             END DO
                0490           END DO
                0491
                0492 !---- write out number of cg iters
                0493
                0494           WRITE(MSGBUF,'(A,I5)') 'streamice adjoint solve number'
                0495      +,ADJ_ITER
                0496 !          OAD_CTMP0 = 1
                0497           CALL print_message(MSGBUF,STANDARDMESSAGEUNIT,'R',1)
                0498
                0499 !---- end write out number of cg iters
                0500
                0501 !---- conv check
                0502
                0503           if (STREAMICE_chkfixedptconvergence) then
                0504
                0505            CALL openad_STREAMICE_GET_FP_ERR_OAD ( err_max_fp, myThid )
                0506
                0507            WRITE(msgBuf,'(A,1PE22.14)') 'STREAMICE_FP_ADJ_ERROR =',
                0508      &                       err_max_fp
                0509            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0510      &                    SQUEEZE_RIGHT , 1)
                0511
                0512            IF(adj_iter.eq.1) then
                0513             err_init = err_max_fp
                0514            ELSE
                0515             IF (err_max_fp .LE.
                0516      &             streamice_nonlin_tol_adjoint_rl*err_init) THEN
                0517              ADJ_CONVERGED = .true.
                0518             ELSEIF (err_max_fp .LE.
                0519      &             streamice_nonlin_tol_adjoint) THEN
                0520              ADJ_CONVERGED = .true.
                0521             ELSEIF (err_max_fp > err_last_change) THEN
                0522              ADJ_CONVERGED = .true.
                0523              WRITE(msgBuf,'(A)') 'STOP: ADJOINT FP ERROR INCREASING'
                0524              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0525      &                    SQUEEZE_RIGHT , 1)
                0526             ENDIF
                0527 #ifdef ALLOW_PETSC
                0528             IF (STREAMICE_OAD_petsc_reuse.AND.ADJ_CONVERGED) THEN
                0529               STREAMICE_need2createmat=.true.
                0530               STREAMICE_need2destroymat=.true.
                0531               CALL streamice_petscmatdestroy(myThid)
                0532               PETSC_PRECOND_TYPE = PETSC_PRECOND_TMP
                0533             ENDIF
                0534 #endif
                0535
                0536            ENDIF
                0537
                0538            err_last_change = err_max_fp
                0539
                0540           endif
                0541
                0542 !--------conv check done
                0543
                0544           DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1
                0545             DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1
                0546               DO J = 1-OLy,sNy+OLy
                0547                 DO I = 1-OLx,sNx+OLx
                0548
                0549                   U_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = U_STREAMICE(
                0550      +I,J,BI,BJ)%d
                0551                   V_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = V_STREAMICE(
                0552      +I,J,BI,BJ)%d
                0553 #ifdef STREAMICE_HYBRID_STRESS
                0554                   TAUBX_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = STREAMIC
                0555      +E_TAUBX(I,J,BI,BJ)%d
                0556                   TAUBY_NEW_SI(INT(I),INT(J),INT(BI),INT(BJ))%d = STREAMIC
                0557      +E_TAUBY(I,J,BI,BJ)%d
                0558                   DO m=Nr,1,-1
                0559                   VISC_FULL_NEW_SI(INT(I),INT(J),m,INT(BI),INT(BJ))%d =
                0560      +VISC_STREAMICE_FULL(I,J,m,BI,BJ)%d
                0561                   ENDDO
                0562 #endif
                0563
                0564                   U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0565      +U_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0566                   V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0567      +V_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0568 #ifdef STREAMICE_HYBRID_STRESS
                0569                   streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0570      +taubx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0571                   streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0572      +tauby_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0573                   DO m=Nr,1,-1
                0574                   visc_streamice_full(I,J,m,BI,BJ)%d =
                0575      +visc_full_dummy_d(I,J,m,BI,BJ)
                0576                   ENDDO
                0577 #endif
                0578
                0579 #ifdef STREAMICE_ALLOW_FRIC_CONTROL
                0580                   C_basal_friction(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0581      +C_basal_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0582 #endif
                0583 #ifdef STREAMICE_ALLOW_BGLEN_CONTROL
                0584                   b_glen(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0585      +B_glen_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0586 #endif
                0587 #ifdef STREAMICE_ALLOW_DEPTH_CONTROL
                0588                   R_low_si(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0589      +R_low_si_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0590 #endif
                0591                   H_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0592      +H_streamice_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0593                   taudx_si(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0594      +taudx_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0595                   taudy_si(INT(I),INT(J),INT(BI),INT(BJ))%d =
                0596      +taudy_dummy_d(INT(I),INT(J),INT(BI),INT(BJ))
                0597
                0598                 END DO
                0599               END DO
                0600             END DO
                0601           END DO
                0602
                0603           oad_dt_ptr = temp_double_tape_pointer
                0604           oad_it_ptr = temp_integer_tape_pointer
                0605           oad_lt_ptr = temp_logical_tape_pointer
                0606           oad_st_ptr = temp_string_tape_pointer
                0607
                0608           if (adj_iter.eq.1) then
                0609            CALL TIMER_STOP('STREAMICE ADJ FIXED POINT LOOP0',myThid)
                0610           else
                0611            CALL TIMER_STOP('STREAMICE ADJ FIXED POINT LOOP',myThid)
                0612           endif
                0613         end if
                0614       end if
                0615
                0616       if(isinloop.eq.0) then
                0617
                0618           CALL OpenAD_streamice_vel_phi(MYTHID,MAXNLITER,MAXCGITER,CGTOL
                0619      +,CG_ITERS,err_max)
                0620
                0621           DO BJ = MYBYLO(MYTHID), MYBYHI(MYTHID), 1
                0622             DO BI = MYBXLO(MYTHID), MYBXHI(MYTHID), 1
                0623               DO J = 1-OLy,sNy+OLy
                0624                 DO I = 1-OLx,sNx+OLx
                0625
                0626                   U_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0
                0627                   V_streamice(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0
                0628 #ifdef STREAMICE_HYBRID_STRESS
                0629               streamice_taubx(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0
                0630               streamice_tauby(INT(I),INT(J),INT(BI),INT(BJ))%d = 0. _d 0
                0631                   DO m=Nr,1,-1
                0632         visc_streamice_full(INT(I),INT(J),m,INT(BI),INT(BJ))%d = 0. _d 0
                0633                   ENDDO
                0634 #endif
                0635
                0636                 END DO
                0637               END DO
                0638             END DO
                0639           END DO
                0640
                0641       end if
                0642
                0643       our_rev_mode=our_orig_mode
                0644       end if
                0645
                0646 #endif
                0647
                0648       end subroutine template
                0649