pkg/admtlm/admtlm_bypassad.F

b35bd3101a Jean*0001 #include "ADMTLM_OPTIONS.h"
f8659cb5d2 Patr*0002
                0003       subroutine admtlm_bypassad( myThid )
                0004 C     /==========================================================\
                0005 C     | subroutine admtlm_bypassad                               |
                0006 C     | o This routine assigns final T,S to cost function        |
                0007 C     \==========================================================/
                0008        implicit none
                0009
                0010 C     == Global variables ===
                0011 #include "SIZE.h"
                0012 #include "EEPARAMS.h"
                0013 #include "PARAMS.h"
ea498bf65a Patr*0014 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
4d72283393 Mart*0015 # include "CTRL.h"
edcd27be69 Mart*0016 # include "CTRL_DUMMY.h"
65754df434 Mart*0017 # include "OPTIMCYCLE.h"
f8659cb5d2 Patr*0018 # include "adcost.h"
                0019 # include "g_cost.h"
                0020 # include "adcommon.h"
                0021 #endif
                0022
                0023 C     ======== Routine arguments ======================
                0024 C     myThid - Thread number for this instance of the routine.
                0025       integer myThid
                0026
ea498bf65a Patr*0027 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
f8659cb5d2 Patr*0028
                0029 C     ========= Local variables =========================
                0030       integer i, j, k
                0031       integer bi, bj
                0032       integer imin, imax
                0033       integer jmin, jmax
                0034       integer itlo, ithi
                0035       integer jtlo, jthi
                0036       integer il
                0037
                0038       logical ladinit
                0039       logical doglobalread
                0040       logical equal
                0041       double precision fac
                0042       character*(80) fnamegeneric
                0043
7c50f07931 Mart*0044       _RL tmpfld2d (1-olx:snx+olx,1-oly:sny+oly,   nsx,nsy)
                0045       _RL tmpfld3d (1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
                0046
f8659cb5d2 Patr*0047 C     ==============================================
                0048 C     declare external procedures and functions
                0049 C     ==============================================
                0050       integer ilnblnk
                0051       external ilnblnk
                0052
                0053 C     ===================================================
                0054
                0055       jtlo = mybylo(mythid)
                0056       jthi = mybyhi(mythid)
                0057       itlo = mybxlo(mythid)
                0058       ithi = mybxhi(mythid)
                0059       jmin = 1
                0060       jmax = sny
                0061       imin = 1
                0062       imax = snx
305d315bb8 Jean*0063       doglobalread =  .false.
                0064       ladinit =  .false.
                0065       equal =  .true.
f8659cb5d2 Patr*0066       if (equal) then
                0067         fac = 1.d0
                0068       else
                0069         fac = 0.d0
                0070       endif
                0071
                0072       DO bj = jtlo, jthi
                0073        DO bi = itlo, ithi
                0074         DO j = jmin, jmax
                0075          DO i = imin, imax
                0076           DO k=1,Nr
305d315bb8 Jean*0077             adtheta(i,j,k,bi,bj) =
f8659cb5d2 Patr*0078      &       g_objf_state_final(i,j,bi,bj,k)
305d315bb8 Jean*0079             adsalt(i,j,k,bi,bj) =
f8659cb5d2 Patr*0080      &       g_objf_state_final(i,j,bi,bj,1*Nr+k)
305d315bb8 Jean*0081             aduvel(i,j,k,bi,bj) =
f8659cb5d2 Patr*0082      &       g_objf_state_final(i,j,bi,bj,2*Nr+k)
305d315bb8 Jean*0083             advvel(i,j,k,bi,bj) =
f8659cb5d2 Patr*0084      &       g_objf_state_final(i,j,bi,bj,3*Nr+k)
                0085           END DO
305d315bb8 Jean*0086           adetan(i,j,bi,bj) =
f8659cb5d2 Patr*0087      &       g_objf_state_final(i,j,bi,bj,4*Nr+1)
                0088          END DO
                0089         END DO
                0090        END DO
                0091       END DO
                0092
                0093 c---------------------------------------------------------------------
                0094
                0095       do bj = jtlo, jthi
                0096         do bi = itlo, ithi
                0097           do j = jmin, jmax
                0098             do i = imin, imax
                0099               tmpfld2d(i,j,bi,bj) = tmpfld2d(i,j,bi,bj)
                0100      &              + adetan(i,j,bi,bj)
                0101             end do
                0102           end do
                0103         end do
                0104       end do
                0105       il = ilnblnk(xx_etan_file)
305d315bb8 Jean*0106       write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
f8659cb5d2 Patr*0107      &     xx_etan_file(1:il),'.',optimcycle
                0108       call adactive_read_xy_loc( fnamegeneric,1,doglobalread,ladinit,
                0109      &     optimcycle,mythid,tmpfld2d )
                0110 c--
                0111       do bj = jtlo, jthi
                0112         do bi = itlo, ithi
                0113           do k = 1, nr
                0114             do j = jmin, jmax
                0115               do i = imin, imax
                0116                 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
                0117      &                + advvel(i,j,k,bi,bj)
                0118               end do
                0119             end do
                0120           end do
                0121         end do
                0122       end do
                0123       il = ilnblnk(xx_vvel_file)
305d315bb8 Jean*0124       write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
f8659cb5d2 Patr*0125      &     xx_vvel_file(1:il),'.',optimcycle
                0126       call adactive_read_xyz( fnamegeneric,1,doglobalread,ladinit,
                0127      &     optimcycle,mythid,tmpfld3d )
                0128 c--
                0129       do bj = jtlo, jthi
                0130         do bi = itlo, ithi
                0131           do k = 1, nr
                0132             do j = jmin, jmax
                0133               do i = imin, imax
                0134                 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
                0135      &                + aduvel(i,j,k,bi,bj)
                0136               end do
                0137             end do
                0138           end do
                0139         end do
                0140       end do
                0141       il = ilnblnk(xx_uvel_file)
305d315bb8 Jean*0142       write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
f8659cb5d2 Patr*0143      &     xx_uvel_file(1:il),'.',optimcycle
                0144       call adactive_read_xyz( fnamegeneric,1,doglobalread,ladinit,
                0145      &     optimcycle,mythid,tmpfld3d )
                0146 c--
                0147       do bj = jtlo, jthi
                0148         do bi = itlo, ithi
                0149           do k = 1, nr
                0150             do j = jmin, jmax
                0151               do i = imin, imax
                0152                 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
                0153      &                + adsalt(i,j,k,bi,bj)*fac
                0154               end do
                0155             end do
                0156           end do
                0157         end do
                0158       end do
                0159       il = ilnblnk(xx_salt_file)
305d315bb8 Jean*0160       write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
f8659cb5d2 Patr*0161      &     xx_salt_file(1:il),'.',optimcycle
                0162       call adactive_read_xyz_loc( fnamegeneric,1,doglobalread,ladinit,
                0163      &     optimcycle,mythid,tmpfld3d )
                0164 c--
                0165       do bj = jtlo, jthi
                0166         do bi = itlo, ithi
                0167           do k = 1, nr
                0168             do j = jmin, jmax
                0169               do i = imin, imax
                0170                 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
                0171      &                + adtheta(i,j,k,bi,bj)*fac
                0172               end do
                0173             end do
                0174           end do
                0175         end do
                0176       end do
                0177       il = ilnblnk(xx_theta_file)
305d315bb8 Jean*0178       write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
f8659cb5d2 Patr*0179      &     xx_theta_file(1:il),'.',optimcycle
                0180       call adactive_read_xyz_loc( fnamegeneric,1,doglobalread,ladinit,
                0181      &     optimcycle,mythid,tmpfld3d )
                0182
                0183 #endif
305d315bb8 Jean*0184
f8659cb5d2 Patr*0185       end