Back to home page

MITgcm
 
 

    

File indexing completed on 2023-11-05 05:10:01 UTC

view on githubraw file Latest commit 65754df4 on 2023-11-04 17:55:24 UTC
b35bd3101a Jean*0001 #include "ADMTLM_OPTIONS.h"
a235da16e6 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
e4939baa16 Patr*0005 
f3ec8d3513 Jean*0006       subroutine admtlm_dsvd2model(
ea498bf65a Patr*0007      &     first, postprocev, mythid )
faf44775ba Patr*0008 
                0009 c     ==================================================================
37e373688b Mart*0010 c     SUBROUTINE admtlm_dsvd2model
faf44775ba Patr*0011 c     ==================================================================
                0012 c
37e373688b Mart*0013 c     o Unpack the control vector such that the land points are filled in.
faf44775ba Patr*0014 c
                0015 c     ==================================================================
37e373688b Mart*0016 c     SUBROUTINE admtlm_dsvd2model
faf44775ba Patr*0017 c     ==================================================================
                0018 
                0019       implicit none
                0020 
                0021 c     == global variables ==
e4939baa16 Patr*0022 
                0023 #include "EEPARAMS.h"
faf44775ba Patr*0024 #include "SIZE.h"
e4939baa16 Patr*0025 #include "PARAMS.h"
faf44775ba Patr*0026 #include "GRID.h"
                0027 
4d72283393 Mart*0028 #include "CTRL.h"
65754df434 Mart*0029 #include "OPTIMCYCLE.h"
faf44775ba Patr*0030 
                0031 #ifdef ALLOW_COST
                0032 # include "cost.h"
                0033 #endif
                0034 #ifdef ALLOW_ECCO
                0035 # include "ecco_cost.h"
                0036 #else
                0037 # include "ctrl_weights.h"
e4939baa16 Patr*0038 #endif
                0039 
faf44775ba Patr*0040 c     == routine arguments ==
                0041 
                0042       logical first
ea498bf65a Patr*0043       logical postprocev
faf44775ba Patr*0044       integer mythid
                0045 
                0046 #ifndef EXCLUDE_CTRL_PACK
                0047 c     == local variables ==
e4939baa16 Patr*0048 
                0049       integer i, j, k
faf44775ba Patr*0050       integer ii
                0051       integer il
                0052       integer irec
                0053       integer ivartype
                0054       integer ictrlgrad
                0055 
                0056       integer cbuffindex
                0057       integer cunit
                0058 
                0059       character*(128) cfile
                0060       character*( 80) weighttype
                0061 
                0062       logical lxxadxx
f3ec8d3513 Jean*0063 
faf44775ba Patr*0064 cgg(  Add OBCS mask names.
                0065 #ifdef ALLOW_OBCSN_CONTROL
                0066       integer        filenWetobcsnGlo(nr,nobcs)
                0067 #endif
                0068 #ifdef ALLOW_OBCSS_CONTROL
                0069       integer        filenWetobcssGlo(nr,nobcs)
                0070 #endif
                0071 #ifdef ALLOW_OBCSW_CONTROL
                0072       integer        filenWetobcswGlo(nr,nobcs)
                0073 #endif
                0074 #ifdef ALLOW_OBCSE_CONTROL
                0075       integer        filenWetobcseGlo(nr,nobcs)
                0076 #endif
                0077       integer iobcs
                0078 cgg)
                0079 
                0080 c     == external ==
                0081 
                0082       integer  ilnblnk
                0083       external ilnblnk
                0084 
                0085 c     == end of interface ==
                0086 
                0087 c--   Initialise
                0088       nbuffGlobal = 0
                0089 
                0090 cph-new(
ea498bf65a Patr*0091       if ( postprocev ) then
                0092          yadprefix = 'ev'
                0093       else
                0094          yadprefix = 'g_'
                0095       endif
faf44775ba Patr*0096       nveccount = 0
                0097 cph-new)
                0098 
                0099 c--   Assign file names.
                0100 
                0101       call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
                0102       call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
                0103       call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
                0104       call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
                0105       call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
                0106       call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
                0107       call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
                0108       call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
                0109       call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
                0110       call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
                0111       call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
                0112       call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
                0113       call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
                0114       call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
                0115       call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
                0116       call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
                0117       call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
                0118       call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
                0119       call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
                0120       call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
                0121       call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
                0122       call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
467436b986 Patr*0123       call ctrl_set_fname(xx_depth_file, fname_depth, mythid)
faf44775ba Patr*0124       call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
                0125       call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
                0126       call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
                0127       call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
                0128       call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
                0129       call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
                0130       call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
                0131       call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
                0132       call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
                0133       call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
                0134 
                0135 c--     Only the master thread will do I/O.
                0136         _BEGIN_MASTER( mythid )
                0137 
                0138 c *********************************************************************
                0139 
                0140       if ( first ) then
                0141 c     >>> Initialise control vector for optimcycle=0 <<<
                0142           lxxadxx   = .TRUE.
                0143           ictrlgrad = 1
                0144           write(cfile(1:128),'(4a,i4.4)')
f3ec8d3513 Jean*0145      &         ctrlname(1:9),'_',yctrlid(1:10),
faf44775ba Patr*0146      &         yctrlposunpack(1:4), optimcycle
                0147           print *, 'ph-pack: unpacking ', ctrlname(1:9)
                0148       else
                0149 c     >>> Write gradient vector <<<
                0150           lxxadxx   = .FALSE.
                0151           ictrlgrad = 2
                0152           write(cfile(1:128),'(4a,i4.4)')
                0153      &         costname(1:9),'_',yctrlid(1:10),
                0154      &         yctrlposunpack(1:4), optimcycle
                0155           print *, 'ph-pack: unpacking ', costname(1:9)
                0156        endif
                0157 
                0158        call mdsfindunit( cunit, mythid )
                0159 
                0160 #ifdef ALLOW_ADMTLM
                0161 
ea498bf65a Patr*0162        if (postprocev) then
                0163 cph do a dummy read of initialized EV fields
                0164 cph they will be overwritten by array phtmpadmtlm
                0165           write(cfile(1:128),'(a)') ' '
f3ec8d3513 Jean*0166           write(cfile,'(a,i4.4)')
ea498bf65a Patr*0167      &         'admtlm_eigen', optimcycle
                0168        else
                0169           write(cfile(1:128),'(a)') ' '
f3ec8d3513 Jean*0170           write(cfile,'(a,i4.4)')
ea498bf65a Patr*0171      &         'admtlm_vector.it', optimcycle
                0172        endif
faf44775ba Patr*0173        print *, 'ph-pack: unpacking ', cfile
ea498bf65a Patr*0174 cph       open( cunit, file   = cfile,
                0175 cph     &      status = 'old',
                0176 cph     &      form   = 'unformatted',
                0177 cph     &      access  = 'sequential'   )
faf44775ba Patr*0178 
                0179 #else /* ndef ALLOW_ADMTLM */
                0180 
                0181           open( cunit, file   = cfile,
                0182      &         status = 'old',
                0183      &         form   = 'unformatted',
                0184      &         access  = 'sequential'   )
                0185 
                0186 c--       Header information.
                0187           read(cunit) filenvartype
                0188           read(cunit) filenvarlength
                0189           read(cunit) fileYctrlid
                0190           read(cunit) fileOptimCycle
                0191           read(cunit) filefc
                0192           read(cunit) fileIg
                0193           read(cunit) fileJg
                0194           read(cunit) filensx
                0195           read(cunit) filensy
                0196           read(cunit) (filenWetcGlobal(k),   k=1,nr)
                0197           read(cunit) (filenWetsGlobal(k),   k=1,nr)
                0198           read(cunit) (filenWetwGlobal(k),   k=1,nr)
                0199 #ifdef ALLOW_CTRL_WETV
                0200           read(cunit) (filenWetvGlobal(k),   k=1,nr)
                0201 #endif
                0202 
                0203 cgg(     Add OBCS mask information to the header.
                0204 #ifdef ALLOW_OBCSN_CONTROL
                0205           read(cunit) ((filenWetobcsnGlo(k,iobcs),
                0206      &         k=1,nr), iobcs= 1,nobcs)
                0207 #endif
                0208 #ifdef ALLOW_OBCSS_CONTROL
                0209           read(cunit) ((filenWetobcssGlo(k,iobcs),
                0210      &         k=1,nr), iobcs= 1,nobcs)
                0211 #endif
                0212 #ifdef ALLOW_OBCSW_CONTROL
                0213           read(cunit) ((filenWetobcswGlo(k,iobcs),
                0214      &         k=1,nr), iobcs= 1,nobcs)
                0215 #endif
                0216 #ifdef ALLOW_OBCSE_CONTROL
                0217           read(cunit) ((filenWetobcseGlo(k,iobcs),
                0218      &         k=1,nr), iobcs= 1,nobcs)
                0219 #endif
                0220 cgg)
                0221           read(cunit) (filencvarindex(i), i=1,maxcvars)
                0222           read(cunit) (filencvarrecs(i),  i=1,maxcvars)
                0223           read(cunit) (filencvarxmax(i),  i=1,maxcvars)
                0224           read(cunit) (filencvarymax(i),  i=1,maxcvars)
                0225           read(cunit) (filencvarnrmax(i), i=1,maxcvars)
                0226           read(cunit) (filencvargrd(i),   i=1,maxcvars)
                0227           read(cunit)
                0228 
                0229 c         Check file header info.
                0230 c
                0231           if ( filenvarlength .NE. nvarlength ) then
                0232              print *, 'WARNING: wrong nvarlength ',
                0233      &            filenvarlength, nvarlength
                0234              STOP 'in S/R ctrl_unpack'
                0235           else if ( filensx .NE. nsx .OR. filensy .NE. nsy ) then
                0236              print *, 'WARNING: wrong nsx or nsy ',
                0237      &            filensx, nsx, filensy, nsy
                0238              STOP 'in S/R ctrl_unpack'
                0239           endif
                0240           do k = 1, nr
                0241              if ( filenWetcGlobal(k) .NE. nWetcGlobal(k) .OR.
                0242      &            filenWetsGlobal(k) .NE. nWetsGlobal(k) .OR.
                0243      &            filenWetwGlobal(k) .NE. nWetwGlobal(k) .OR.
                0244      &            filenWetvGlobal(k) .NE. nWetvGlobal(k)  ) then
                0245                 print *, 'WARNING: wrong nWet?Global for k = ', k
                0246                 STOP
                0247              endif
                0248           end do
                0249 
                0250 cgg(   Lets also check the OBCS mask info in the header.
                0251 
                0252 #ifdef ALLOW_OBCSN_CONTROL
                0253        do iobcs = 1, nobcs
                0254          do k = 1, nr
f3ec8d3513 Jean*0255            if (filenWetobcsnGlo(k,iobcs) .NE.
faf44775ba Patr*0256      &           nWetobcsnGlo(k,iobcs)) then
                0257              print *, 'WARNING: OBCSN wrong nWet?Global for k = ', k
                0258              STOP
                0259            endif
                0260          end do
                0261        end do
                0262 #endif
                0263 
                0264 #ifdef ALLOW_OBCSS_CONTROL
                0265        do iobcs = 1, nobcs
                0266          do k = 1, nr
f3ec8d3513 Jean*0267            if (filenWetobcssGlo(k,iobcs) .NE.
faf44775ba Patr*0268      &           nWetobcssGlo(k,iobcs)) then
                0269              print *, 'WARNING: OBCSS wrong nWet?Global for k = ', k
                0270              STOP
                0271            endif
                0272          end do
                0273        end do
                0274 #endif
                0275 
                0276 #ifdef ALLOW_OBCSW_CONTROL
                0277        do iobcs = 1, nobcs
                0278          do k = 1, nr
f3ec8d3513 Jean*0279            if (filenWetobcswGlo(k,iobcs) .NE.
faf44775ba Patr*0280      &           nWetobcswGlo(k,iobcs)) then
                0281              print *, 'WARNING: OBCSW wrong nWet?Global for k = ', k
                0282              STOP
                0283            endif
                0284          end do
                0285        end do
                0286 #endif
                0287 
                0288 #ifdef ALLOW_OBCSE_CONTROL
                0289        do iobcs = 1, nobcs
                0290          do k = 1, nr
f3ec8d3513 Jean*0291            if (filenWetobcseGlo(k,iobcs) .NE.
faf44775ba Patr*0292      &           nWetobcseGlo(k,iobcs)) then
                0293              print *, 'WARNING: OBCSE wrong nWet?Global for k = ', k
                0294              STOP
                0295            endif
                0296          end do
                0297        end do
                0298 #endif
                0299 cgg)  End OBCS mask check.
                0300 
                0301 #endif /* ndef ALLOW_ADMTLM */
                0302 
                0303 c----------------------------------------------------------------------
                0304 
                0305 #ifdef ALLOW_THETA0_CONTROL
                0306           ivartype = 1
                0307           write(weighttype(1:80),'(80a)') ' '
                0308           write(weighttype(1:80),'(a)') "wtheta"
                0309           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0310      &         fname_theta(ictrlgrad), "maskCtrlC",
                0311      &         weighttype, wtheta, nwetcglobal, mythid)
                0312 #endif
                0313 
                0314 #ifdef ALLOW_SALT0_CONTROL
                0315           ivartype = 2
                0316           write(weighttype(1:80),'(80a)') ' '
                0317           write(weighttype(1:80),'(a)') "wsalt"
                0318           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0319      &         fname_salt(ictrlgrad), "maskCtrlC",
                0320      &         weighttype, wsalt, nwetcglobal, mythid)
                0321 #endif
                0322 
                0323 #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
                0324           ivartype    = 3
                0325           write(weighttype(1:80),'(80a)') ' '
                0326           write(weighttype(1:80),'(a)') "whflux"
                0327           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0328      &         fname_hflux(ictrlgrad), "maskCtrlC",
                0329      &         weighttype, nwetcglobal, mythid)
                0330 #endif
                0331 
                0332 #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
                0333           ivartype = 4
                0334           write(weighttype(1:80),'(80a)') ' '
                0335           write(weighttype(1:80),'(a)') "wsflux"
                0336           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0337      &         fname_sflux(ictrlgrad), "maskCtrlC",
                0338      &         weighttype, nwetcglobal, mythid)
                0339 #endif
                0340 
                0341 #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
                0342           ivartype = 5
                0343           write(weighttype(1:80),'(80a)') ' '
                0344           write(weighttype(1:80),'(a)') "wtauu"
                0345           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0346      &         fname_tauu(ictrlgrad), "maskCtrlW",
                0347      &         weighttype, nwetwglobal, mythid)
                0348 #endif
                0349 
                0350 #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
                0351           ivartype = 6
                0352           write(weighttype(1:80),'(80a)') ' '
                0353           write(weighttype(1:80),'(a)') "wtauv"
                0354           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0355      &         fname_tauv(ictrlgrad), "maskCtrlS",
                0356      &         weighttype, nwetsglobal, mythid)
                0357 #endif
                0358 
                0359 #ifdef ALLOW_ATEMP_CONTROL
                0360           ivartype    = 7
                0361           write(weighttype(1:80),'(80a)') ' '
                0362           write(weighttype(1:80),'(a)') "watemp"
                0363           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0364      &         fname_atemp(ictrlgrad), "maskCtrlC",
                0365      &         weighttype, nwetcglobal, mythid)
                0366 #endif
                0367 
                0368 #ifdef ALLOW_AQH_CONTROL
                0369           ivartype    = 8
                0370           write(weighttype(1:80),'(80a)') ' '
                0371           write(weighttype(1:80),'(a)') "waqh"
                0372           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0373      &         fname_aqh(ictrlgrad), "maskCtrlC",
                0374      &         weighttype, nwetcglobal, mythid)
                0375 #endif
                0376 
                0377 #ifdef ALLOW_UWIND_CONTROL
                0378           ivartype    = 9
                0379           write(weighttype(1:80),'(80a)') ' '
                0380           write(weighttype(1:80),'(a)') "wuwind"
                0381           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0382      &         fname_uwind(ictrlgrad), "maskCtrlC",
                0383      &         weighttype, nwetcglobal, mythid)
                0384 #endif
                0385 
                0386 #ifdef ALLOW_VWIND_CONTROL
                0387           ivartype    = 10
                0388           write(weighttype(1:80),'(80a)') ' '
                0389           write(weighttype(1:80),'(a)') "wvwind"
                0390           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0391      &         fname_vwind(ictrlgrad), "maskCtrlC",
                0392      &         weighttype, nwetcglobal, mythid)
                0393 #endif
                0394 
                0395 #ifdef ALLOW_OBCSN_CONTROL
                0396           ivartype    = 11
                0397           write(weighttype(1:80),'(80a)') ' '
                0398           write(weighttype(1:80),'(a)') "wobcsn"
                0399           call ctrl_set_unpack_xz(
                0400      &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
                0401      &         weighttype, wobcsn, nWetobcsnGlo, mythid)
                0402 #endif
                0403 
                0404 #ifdef ALLOW_OBCSS_CONTROL
                0405           ivartype    = 12
                0406           write(weighttype(1:80),'(80a)') ' '
                0407           write(weighttype(1:80),'(a)') "wobcss"
                0408           call ctrl_set_unpack_xz(
                0409      &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
                0410      &         weighttype, wobcss, nWetobcssGlo, mythid)
                0411 #endif
                0412 
                0413 #ifdef ALLOW_OBCSW_CONTROL
                0414           ivartype    = 13
                0415           write(weighttype(1:80),'(80a)') ' '
                0416           write(weighttype(1:80),'(a)') "wobcsw"
                0417           call ctrl_set_unpack_yz(
                0418      &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
                0419      &         weighttype, wobcsw, nWetobcswGlo, mythid)
                0420 #endif
                0421 
                0422 #ifdef ALLOW_OBCSE_CONTROL
                0423           ivartype    = 14
                0424           write(weighttype(1:80),'(80a)') ' '
                0425           write(weighttype(1:80),'(a)') "wobcse"
                0426           call ctrl_set_unpack_yz(
                0427      &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
                0428      &         weighttype, wobcse, nWetobcseGlo, mythid)
                0429 #endif
                0430 
                0431 #ifdef ALLOW_DIFFKR_CONTROL
                0432           ivartype    = 15
                0433           write(weighttype(1:80),'(80a)') ' '
                0434           write(weighttype(1:80),'(a)') "wdiffkr"
                0435           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0436      &         fname_diffkr(ictrlgrad), "maskCtrlC",
                0437      &         weighttype, wunit, nwetcglobal, mythid)
                0438 #endif
                0439 
                0440 #ifdef ALLOW_KAPGM_CONTROL
                0441           ivartype    = 16
                0442           write(weighttype(1:80),'(80a)') ' '
                0443           write(weighttype(1:80),'(a)') "wkapgm"
                0444           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0445      &         fname_kapgm(ictrlgrad), "maskCtrlC",
                0446      &         weighttype, wunit, nwetcglobal, mythid)
                0447 #endif
                0448 
                0449 #ifdef ALLOW_TR10_CONTROL
                0450           ivartype    = 17
                0451           write(weighttype(1:80),'(80a)') ' '
                0452           write(weighttype(1:80),'(a)') "wtr1"
                0453           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0454      &         fname_tr1(ictrlgrad), "maskCtrlC",
                0455      &         weighttype, wunit, nwetcglobal, mythid)
                0456 #endif
                0457 
                0458 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
                0459           ivartype    = 18
                0460           write(weighttype(1:80),'(80a)') ' '
                0461           write(weighttype(1:80),'(a)') "wsst"
                0462           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0463      &         fname_sst(ictrlgrad), "maskCtrlC",
                0464      &         weighttype, nwetcglobal, mythid)
                0465 #endif
                0466 
                0467 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
                0468           ivartype    = 19
                0469           write(weighttype(1:80),'(80a)') ' '
                0470           write(weighttype(1:80),'(a)') "wsss"
                0471           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0472      &         fname_sss(ictrlgrad), "maskCtrlC",
                0473      &         weighttype, nwetcglobal, mythid)
                0474 #endif
                0475 
467436b986 Patr*0476 #ifdef ALLOW_DEPTH_CONTROL
faf44775ba Patr*0477           ivartype    = 20
                0478           write(weighttype(1:80),'(80a)') ' '
467436b986 Patr*0479           write(weighttype(1:80),'(a)') "wdepth"
faf44775ba Patr*0480           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
467436b986 Patr*0481      &         fname_depth(ictrlgrad), "maskCtrlC",
faf44775ba Patr*0482      &         weighttype, weighttype, nwetcglobal, mythid)
                0483 #endif
                0484 
                0485 #ifdef ALLOW_EFLUXY0_CONTROL
                0486           ivartype    = 21
                0487           write(weighttype(1:80),'(80a)') ' '
                0488           write(weighttype(1:80),'(a)') "wefluxy0"
                0489           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0490      &         fname_efluxy(ictrlgrad), "maskCtrlS",
                0491      &         weighttype, wefluxy, nwetsglobal, mythid)
                0492 #endif
                0493 
                0494 #ifdef ALLOW_EFLUXP0_CONTROL
                0495           ivartype    = 22
                0496           write(weighttype(1:80),'(80a)') ' '
                0497           write(weighttype(1:80),'(a)') "wefluxp0"
                0498           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0499      &         fname_efluxp(ictrlgrad), "maskhFacV",
                0500      &         weighttype, wefluxp, nwetvglobal, mythid)
                0501 #endif
                0502 
                0503 #ifdef ALLOW_BOTTOMDRAG_CONTROL
                0504           ivartype    = 23
                0505           write(weighttype(1:80),'(80a)') ' '
                0506           write(weighttype(1:80),'(a)') "wbottomdrag"
                0507           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0508      &         fname_bottomdrag(ictrlgrad), "maskCtrlC",
                0509      &         weighttype, nwetcglobal, mythid)
                0510 #endif
                0511 
43af9695da Gael*0512 #ifdef ALLOW_EDDYPSI_CONTROL
faf44775ba Patr*0513           ivartype    = 25
                0514           write(weighttype(1:80),'(80a)') ' '
                0515           write(weighttype(1:80),'(a)') "wedtaux"
                0516           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0517      &         fname_edtaux(ictrlgrad), "maskCtrlW",
                0518      &         weighttype, wunit, nwetwglobal, mythid)
                0519 
                0520           ivartype    = 26
                0521           write(weighttype(1:80),'(80a)') ' '
                0522           write(weighttype(1:80),'(a)') "wedtauy"
                0523           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0524      &         fname_edtauy(ictrlgrad), "maskCtrlS",
                0525      &         weighttype, wunit, nwetsglobal, mythid)
                0526 #endif
                0527 
                0528 #ifdef ALLOW_UVEL0_CONTROL
                0529           ivartype = 27
                0530           write(weighttype(1:80),'(80a)') ' '
1259f8b9ed Patr*0531           write(weighttype(1:80),'(a)') "wuvvel"
faf44775ba Patr*0532           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0533      &         fname_uvel(ictrlgrad), "maskCtrlW",
1259f8b9ed Patr*0534      &         weighttype, wuvvel, nwetwglobal, mythid)
faf44775ba Patr*0535 #endif
                0536 
                0537 #ifdef ALLOW_VVEL0_CONTROL
                0538           ivartype = 28
                0539           write(weighttype(1:80),'(80a)') ' '
1259f8b9ed Patr*0540           write(weighttype(1:80),'(a)') "wuvvel"
faf44775ba Patr*0541           call ctrl_set_unpack_xyz( lxxadxx, cunit, ivartype,
                0542      &         fname_vvel(ictrlgrad), "maskCtrlS",
1259f8b9ed Patr*0543      &         weighttype, wuvvel, nwetsglobal, mythid)
faf44775ba Patr*0544 #endif
                0545 
                0546 #ifdef ALLOW_ETAN0_CONTROL
                0547           ivartype = 29
                0548           write(weighttype(1:80),'(80a)') ' '
                0549           write(weighttype(1:80),'(a)') "wetan"
                0550           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0551      &         fname_etan(ictrlgrad), "maskCtrlC",
                0552      &         weighttype, nwetcglobal, mythid)
                0553 #endif
                0554 
                0555 #ifdef ALLOW_RELAXSST_CONTROL
                0556           ivartype = 30
                0557           write(weighttype(1:80),'(80a)') ' '
                0558           write(weighttype(1:80),'(a)') "wrelaxsst"
                0559           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0560      &         fname_relaxsst(ictrlgrad), "maskCtrlC",
                0561      &         weighttype, nwetcglobal, mythid)
                0562 #endif
                0563 
                0564 #ifdef ALLOW_RELAXSSS_CONTROL
                0565           ivartype = 31
                0566           write(weighttype(1:80),'(80a)') ' '
                0567           write(weighttype(1:80),'(a)') "wrelaxsss"
                0568           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0569      &         fname_relaxsss(ictrlgrad), "maskCtrlC",
                0570      &         weighttype, nwetcglobal, mythid)
                0571 #endif
                0572 
                0573 #ifdef ALLOW_PRECIP_CONTROL
                0574           ivartype    = 32
                0575           write(weighttype(1:80),'(80a)') ' '
                0576           write(weighttype(1:80),'(a)') "wprecip"
                0577           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0578      &         fname_precip(ictrlgrad), "maskCtrlC",
                0579      &         weighttype, nwetcglobal, mythid)
                0580 #endif
                0581 
                0582 #ifdef ALLOW_SWFLUX_CONTROL
                0583           ivartype    = 33
                0584           write(weighttype(1:80),'(80a)') ' '
                0585           write(weighttype(1:80),'(a)') "wswflux"
                0586           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0587      &         fname_swflux(ictrlgrad), "maskCtrlC",
                0588      &         weighttype, nwetcglobal, mythid)
                0589 #endif
                0590 
                0591 #ifdef ALLOW_SWDOWN_CONTROL
                0592           ivartype    = 34
                0593           write(weighttype(1:80),'(80a)') ' '
                0594           write(weighttype(1:80),'(a)') "wswdown"
                0595           call ctrl_set_unpack_xy( lxxadxx, cunit, ivartype,
                0596      &         fname_swdown(ictrlgrad), "maskCtrlC",
                0597      &         weighttype, nwetcglobal, mythid)
                0598 #endif
                0599 
                0600          close ( cunit )
f3ec8d3513 Jean*0601 
faf44775ba Patr*0602       _END_MASTER( mythid )
                0603 
                0604 #endif /* EXCLUDE_CTRL_PACK */
                0605 
                0606       return
e4939baa16 Patr*0607       end
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!