Back to home page

MITgcm
 
 

    

File indexing completed on 2023-11-05 05:10:02 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_model2dsvd(
ea498bf65a Patr*0007      &     first, preprocev, mythid )
faf44775ba Patr*0008 
                0009 c     ==================================================================
37e373688b Mart*0010 c     SUBROUTINE admtlm_model2dsvd
faf44775ba Patr*0011 c     ==================================================================
                0012 c
                0013 c     o Compress the control vector such that only ocean points are
                0014 c       written to file.
                0015 c
                0016 c     ==================================================================
37e373688b Mart*0017 c     SUBROUTINE admtlm_model2dsvd
faf44775ba Patr*0018 c     ==================================================================
                0019 
                0020       implicit none
                0021 
                0022 c     == global variables ==
e4939baa16 Patr*0023 
                0024 #include "EEPARAMS.h"
faf44775ba Patr*0025 #include "SIZE.h"
e4939baa16 Patr*0026 #include "PARAMS.h"
faf44775ba Patr*0027 #include "GRID.h"
                0028 
4d72283393 Mart*0029 #include "CTRL.h"
65754df434 Mart*0030 #include "OPTIMCYCLE.h"
faf44775ba Patr*0031 
                0032 #ifdef ALLOW_COST
                0033 # include "cost.h"
                0034 #endif
                0035 #ifdef ALLOW_ECCO
                0036 # include "ecco_cost.h"
                0037 #else
                0038 # include "ctrl_weights.h"
e4939baa16 Patr*0039 #endif
                0040 
faf44775ba Patr*0041 c     == routine arguments ==
                0042 
                0043       logical first
ea498bf65a Patr*0044       logical preprocev
faf44775ba Patr*0045       integer mythid
                0046 
                0047 #ifndef EXCLUDE_CTRL_PACK
                0048 c     == local variables ==
                0049 
e4939baa16 Patr*0050       integer i, j, k
faf44775ba Patr*0051       integer ii
                0052       integer il
                0053       integer irec
                0054       integer ig,jg
                0055       integer ivartype
                0056       integer iobcs
                0057 
                0058       logical doglobalread
                0059       logical ladinit
                0060       integer cbuffindex
                0061       logical lxxadxx
f3ec8d3513 Jean*0062 
faf44775ba Patr*0063       integer cunit
                0064       integer ictrlgrad
                0065 
                0066       character*(128) cfile
                0067       character*( 80) weighttype
                0068 
                0069 c     == external ==
                0070 
                0071       integer  ilnblnk
                0072       external ilnblnk
                0073 
                0074 c     == end of interface ==
                0075 
                0076 c--   Tiled files are used.
                0077       doglobalread = .false.
                0078 
                0079 c--   Initialise adjoint variables on active files.
                0080       ladinit = .false.
                0081 
                0082 c--   Initialise global buffer index
                0083       nbuffglobal = 0
                0084 
ea498bf65a Patr*0085 cph-new(
                0086       if ( preprocev ) then
                0087          yadprefix = 'ev'
                0088       else
                0089          yadprefix = 'ad'
                0090       endif
faf44775ba Patr*0091       nveccount = 0
                0092 cph-new)
                0093 
                0094 c--   Assign file names.
                0095 
                0096       call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
                0097       call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
                0098       call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
                0099       call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
                0100       call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
                0101       call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
                0102       call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
                0103       call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
                0104       call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
                0105       call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
                0106       call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
                0107       call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
                0108       call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
                0109       call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
                0110       call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
                0111       call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
                0112       call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
                0113       call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
                0114       call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
                0115       call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
                0116       call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
                0117       call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
467436b986 Patr*0118       call ctrl_set_fname(xx_depth_file, fname_depth, mythid)
faf44775ba Patr*0119       call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
                0120       call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
                0121       call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
                0122       call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
                0123       call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
                0124       call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
                0125       call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
                0126       call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
                0127       call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
                0128       call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
                0129 
                0130 c--   Only the master thread will do I/O.
                0131       _BEGIN_MASTER( mythid )
                0132 
                0133       if ( first ) then
                0134 c     >>> Initialise control vector for optimcycle=0 <<<
                0135           lxxadxx   = .TRUE.
                0136           ictrlgrad = 1
                0137           write(cfile(1:128),'(4a,i4.4)')
f3ec8d3513 Jean*0138      &         ctrlname(1:9),'_',yctrlid(1:10),
faf44775ba Patr*0139      &         yctrlpospack, optimcycle
                0140           print *, 'ph-pack: packing ', ctrlname(1:9)
                0141       else
                0142 c     >>> Write gradient vector <<<
                0143           lxxadxx   = .FALSE.
                0144           ictrlgrad = 2
                0145           write(cfile(1:128),'(4a,i4.4)')
f3ec8d3513 Jean*0146      &         costname(1:9),'_',yctrlid(1:10),
faf44775ba Patr*0147      &         yctrlpospack, optimcycle
                0148           print *, 'ph-pack: packing ', costname(1:9)
                0149        endif
                0150 
                0151        call mdsfindunit( cunit, mythid )
                0152 
                0153 #ifdef ALLOW_ADMTLM
                0154 
ea498bf65a Patr*0155        if ( preprocev ) then
                0156 cph do a dummy write of initial EV fields
                0157           write(cfile(1:128),'(a)') ' '
f3ec8d3513 Jean*0158           write(cfile,'(a,i4.4)')
ea498bf65a Patr*0159      &         'admtlm_eigen', optimcycle
                0160        else
                0161           write(cfile(1:128),'(a)') ' '
f3ec8d3513 Jean*0162           write(cfile,'(a,i4.4)')
ea498bf65a Patr*0163      &         'admtlm_vector.it', optimcycle + 1
                0164        endif
faf44775ba Patr*0165        print *, 'ph-pack: unpacking ', cfile
ea498bf65a Patr*0166 cph       open( cunit, file   = cfile,
                0167 cph     &      status = 'unknown',
                0168 cph     &      form   = 'unformatted',
                0169 cph     &      access  = 'sequential'   )
faf44775ba Patr*0170 
                0171 #else /* ndef ALLOW_ADMTLM */
                0172 
                0173        open( cunit, file   = cfile,
                0174      &      status = 'unknown',
                0175      &      form   = 'unformatted',
                0176      &      access  = 'sequential'   )
                0177 
                0178 c--       Header information.
                0179           write(cunit) nvartype
                0180           write(cunit) nvarlength
                0181           write(cunit) yctrlid
                0182           write(cunit) optimCycle
                0183           write(cunit) fc
                0184 C     place holder of obsolete variable iG
                0185           write(cunit) 1
                0186 C     place holder of obsolete variable jG
                0187           write(cunit) 1
                0188           write(cunit) nsx
                0189           write(cunit) nsy
                0190           write(cunit) (nWetcGlobal(k), k=1,nr)
                0191           write(cunit) (nWetsGlobal(k), k=1,nr)
                0192           write(cunit) (nWetwGlobal(k), k=1,nr)
                0193 #ifdef ALLOW_CTRL_WETV
                0194           write(cunit) (nWetvGlobal(k), k=1,nr)
                0195 #endif
                0196 
                0197 #ifdef ALLOW_OBCSN_CONTROL
                0198           write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
                0199 #endif
                0200 #ifdef ALLOW_OBCSS_CONTROL
                0201           write(cunit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
                0202 #endif
                0203 #ifdef ALLOW_OBCSW_CONTROL
                0204           write(cunit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
                0205 #endif
                0206 #ifdef ALLOW_OBCSE_CONTROL
                0207           write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
                0208 #endif
                0209           write(cunit) (ncvarindex(i), i=1,maxcvars)
                0210           write(cunit) (ncvarrecs(i),  i=1,maxcvars)
                0211           write(cunit) (ncvarxmax(i),  i=1,maxcvars)
                0212           write(cunit) (ncvarymax(i),  i=1,maxcvars)
                0213           write(cunit) (ncvarnrmax(i), i=1,maxcvars)
                0214           write(cunit) (ncvargrd(i),   i=1,maxcvars)
                0215           write(cunit)
                0216 
                0217 #endif /* ALLOW_ADMTLM */
                0218 
                0219 #ifdef ALLOW_THETA0_CONTROL
                0220           ivartype = 1
                0221           write(weighttype(1:80),'(80a)') ' '
                0222           write(weighttype(1:80),'(a)') "wtheta"
                0223           call ctrl_set_pack_xyz(
                0224      &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
                0225      &         weighttype, wtheta, lxxadxx, mythid)
                0226 #endif
                0227 
                0228 #ifdef ALLOW_SALT0_CONTROL
                0229           ivartype = 2
                0230           write(weighttype(1:80),'(80a)') ' '
                0231           write(weighttype(1:80),'(a)') "wsalt"
                0232           call ctrl_set_pack_xyz(
                0233      &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
                0234      &         weighttype, wsalt, lxxadxx, mythid)
                0235 #endif
                0236 
                0237 #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
                0238           ivartype = 3
                0239           write(weighttype(1:80),'(80a)') ' '
                0240           write(weighttype(1:80),'(a)') "whflux"
                0241           call ctrl_set_pack_xy(
                0242      &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
                0243      &         weighttype, lxxadxx, mythid)
                0244 #endif
                0245 
                0246 #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
                0247           ivartype = 4
                0248           write(weighttype(1:80),'(80a)') ' '
                0249           write(weighttype(1:80),'(a)') "wsflux"
                0250           call ctrl_set_pack_xy(
                0251      &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
                0252      &         weighttype, lxxadxx, mythid)
                0253 #endif
                0254 
                0255 #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
                0256           ivartype = 5
                0257           write(weighttype(1:80),'(80a)') ' '
                0258           write(weighttype(1:80),'(a)') "wtauu"
                0259           call ctrl_set_pack_xy(
                0260      &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
                0261      &         weighttype, lxxadxx, mythid)
                0262 #endif
                0263 
                0264 #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
                0265           ivartype = 6
                0266           write(weighttype(1:80),'(80a)') ' '
                0267           write(weighttype(1:80),'(a)') "wtauv"
                0268           call ctrl_set_pack_xy(
                0269      &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
                0270      &         weighttype, lxxadxx, mythid)
                0271 #endif
                0272 
                0273 #ifdef ALLOW_ATEMP_CONTROL
                0274           ivartype = 7
                0275           write(weighttype(1:80),'(80a)') ' '
                0276           write(weighttype(1:80),'(a)') "watemp"
                0277           call ctrl_set_pack_xy(
                0278      &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
                0279      &         weighttype, lxxadxx, mythid)
                0280 #endif
                0281 
                0282 #ifdef ALLOW_AQH_CONTROL
                0283           ivartype = 8
                0284           write(weighttype(1:80),'(80a)') ' '
                0285           write(weighttype(1:80),'(a)') "waqh"
                0286           call ctrl_set_pack_xy(
                0287      &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
                0288      &         weighttype, lxxadxx, mythid)
                0289 #endif
                0290 
                0291 #ifdef ALLOW_UWIND_CONTROL
                0292           ivartype = 9
                0293           write(weighttype(1:80),'(80a)') ' '
                0294           write(weighttype(1:80),'(a)') "wuwind"
                0295           call ctrl_set_pack_xy(
                0296      &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
                0297      &         weighttype, lxxadxx, mythid)
                0298 #endif
                0299 
                0300 #ifdef ALLOW_VWIND_CONTROL
                0301           ivartype = 10
                0302           write(weighttype(1:80),'(80a)') ' '
                0303           write(weighttype(1:80),'(a)') "wvwind"
                0304           call ctrl_set_pack_xy(
                0305      &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
                0306      &         weighttype, lxxadxx, mythid)
                0307 #endif
                0308 
                0309 #ifdef ALLOW_OBCSN_CONTROL
                0310           ivartype = 11
                0311           write(weighttype(1:80),'(80a)') ' '
                0312           write(weighttype(1:80),'(a)') "wobcsn"
                0313           call ctrl_set_pack_xz(
                0314      &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
                0315      &         weighttype, wobcsn, lxxadxx, mythid)
                0316 #endif
                0317 
                0318 #ifdef ALLOW_OBCSS_CONTROL
                0319           ivartype = 12
                0320           write(weighttype(1:80),'(80a)') ' '
                0321           write(weighttype(1:80),'(a)') "wobcss"
                0322           call ctrl_set_pack_xz(
                0323      &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
                0324      &         weighttype, wobcss, lxxadxx, mythid)
                0325 #endif
                0326 
                0327 #ifdef ALLOW_OBCSW_CONTROL
                0328           ivartype = 13
                0329           write(weighttype(1:80),'(80a)') ' '
                0330           write(weighttype(1:80),'(a)') "wobcsw"
                0331           call ctrl_set_pack_yz(
                0332      &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
                0333      &         weighttype, wobcsw, lxxadxx, mythid)
                0334 #endif
                0335 
                0336 #ifdef ALLOW_OBCSE_CONTROL
                0337           ivartype = 14
                0338           write(weighttype(1:80),'(80a)') ' '
                0339           write(weighttype(1:80),'(a)') "wobcse"
                0340           call ctrl_set_pack_yz(
                0341      &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
                0342      &         weighttype, wobcse, lxxadxx, mythid)
                0343 #endif
                0344 
                0345 #ifdef ALLOW_DIFFKR_CONTROL
                0346           ivartype = 15
                0347           write(weighttype(1:80),'(80a)') ' '
                0348           write(weighttype(1:80),'(a)') "wdiffkr"
                0349           call ctrl_set_pack_xyz(
                0350      &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
                0351      &         weighttype, wunit, lxxadxx, mythid)
                0352 #endif
                0353 
                0354 #ifdef ALLOW_KAPGM_CONTROL
                0355           ivartype = 16
                0356           write(weighttype(1:80),'(80a)') ' '
                0357           write(weighttype(1:80),'(a)') "wkapgm"
                0358           call ctrl_set_pack_xyz(
                0359      &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
                0360      &         weighttype, wunit, lxxadxx, mythid)
                0361 #endif
                0362 
                0363 #ifdef ALLOW_TR10_CONTROL
                0364           ivartype = 17
                0365           write(weighttype(1:80),'(80a)') ' '
                0366           write(weighttype(1:80),'(a)') "wtr1"
                0367           call ctrl_set_pack_xyz(
                0368      &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
                0369      &         weighttype, wunit, lxxadxx, mythid)
                0370 #endif
                0371 
                0372 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
                0373           ivartype = 18
                0374           write(weighttype(1:80),'(80a)') ' '
                0375           write(weighttype(1:80),'(a)') "wsst"
                0376           call ctrl_set_pack_xy(
                0377      &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
                0378      &         weighttype, lxxadxx, mythid)
                0379 #endif
                0380 
                0381 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
                0382           ivartype = 19
                0383           write(weighttype(1:80),'(80a)') ' '
                0384           write(weighttype(1:80),'(a)') "wsss"
                0385           call ctrl_set_pack_xy(
                0386      &         cunit, ivartype, fname_sss(ictrlgrad), "maskCtrlC",
                0387      &         weighttype, lxxadxx, mythid)
                0388 #endif
                0389 
467436b986 Patr*0390 #ifdef ALLOW_DEPTH_CONTROL
faf44775ba Patr*0391           ivartype = 20
                0392           write(weighttype(1:80),'(80a)') ' '
467436b986 Patr*0393           write(weighttype(1:80),'(a)') "wdepth"
faf44775ba Patr*0394           call ctrl_set_pack_xy(
467436b986 Patr*0395      &         cunit, ivartype, fname_depth(ictrlgrad), "maskCtrlC",
faf44775ba Patr*0396      &         weighttype, lxxadxx, mythid)
                0397 #endif
                0398 
                0399 #ifdef ALLOW_EFLUXY0_CONTROL
                0400           ivartype = 21
                0401           write(weighttype(1:80),'(80a)') ' '
                0402           write(weighttype(1:80),'(a)') "wefluxy0"
                0403           call ctrl_set_pack_xyz(
                0404      &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
                0405      &         weighttype, wunit, lxxadxx, mythid)
                0406 #endif
                0407 
                0408 #ifdef ALLOW_EFLUXP0_CONTROL
                0409           ivartype = 22
                0410           write(weighttype(1:80),'(80a)') ' '
                0411           write(weighttype(1:80),'(a)') "wefluxp0"
                0412           call ctrl_set_pack_xyz(
                0413      &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
                0414      &         weighttype, wunit, lxxadxx, mythid)
                0415 #endif
                0416 
                0417 #ifdef ALLOW_BOTTOMDRAG_CONTROL
                0418           ivartype = 23
                0419           write(weighttype(1:80),'(80a)') ' '
                0420           write(weighttype(1:80),'(a)') "wbottomdrag"
                0421           call ctrl_set_pack_xy(
                0422      &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
                0423      &      weighttype, lxxadxx, mythid)
                0424 #endif
                0425 
43af9695da Gael*0426 #ifdef ALLOW_EDDYPSI_CONTROL
faf44775ba Patr*0427           ivartype = 25
                0428           write(weighttype(1:80),'(80a)') ' '
                0429           write(weighttype(1:80),'(a)') "wedtaux"
                0430           call ctrl_set_pack_xyz(
                0431      &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
                0432      &         weighttype, wunit, lxxadxx, mythid)
                0433 
                0434           ivartype = 26
                0435           write(weighttype(1:80),'(80a)') ' '
                0436           write(weighttype(1:80),'(a)') "wedtauy"
                0437           call ctrl_set_pack_xyz(
                0438      &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
                0439      &         weighttype, wunit, lxxadxx, mythid)
                0440 #endif
                0441 
                0442 #ifdef ALLOW_UVEL0_CONTROL
                0443           ivartype = 27
                0444           write(weighttype(1:80),'(80a)') ' '
1259f8b9ed Patr*0445           write(weighttype(1:80),'(a)') "wuvvel"
faf44775ba Patr*0446           call ctrl_set_pack_xyz(
                0447      &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
1259f8b9ed Patr*0448      &         weighttype, wuvvel, lxxadxx, mythid)
faf44775ba Patr*0449 #endif
                0450 
                0451 #ifdef ALLOW_VVEL0_CONTROL
                0452           ivartype = 28
                0453           write(weighttype(1:80),'(80a)') ' '
1259f8b9ed Patr*0454           write(weighttype(1:80),'(a)') "wuvvel"
faf44775ba Patr*0455           call ctrl_set_pack_xyz(
                0456      &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
1259f8b9ed Patr*0457      &         weighttype, wuvvel, lxxadxx, mythid)
faf44775ba Patr*0458 #endif
                0459 
                0460 #ifdef ALLOW_ETAN0_CONTROL
                0461           ivartype = 29
                0462           write(weighttype(1:80),'(80a)') ' '
                0463           write(weighttype(1:80),'(a)') "wetan"
                0464           call ctrl_set_pack_xy(
                0465      &         cunit, ivartype, fname_etan(ictrlgrad), "maskCtrlC",
                0466      &         weighttype, lxxadxx, mythid)
                0467 #endif
                0468 
                0469 #ifdef ALLOW_RELAXSST_CONTROL
                0470           ivartype = 30
                0471           write(weighttype(1:80),'(80a)') ' '
                0472           write(weighttype(1:80),'(a)') "wrelaxsst"
                0473           call ctrl_set_pack_xy(
                0474      &         cunit, ivartype, fname_relaxsst(ictrlgrad), "maskCtrlC",
                0475      &         weighttype, lxxadxx, mythid)
                0476 #endif
                0477 
                0478 #ifdef ALLOW_RELAXSSS_CONTROL
                0479           ivartype = 31
                0480           write(weighttype(1:80),'(80a)') ' '
                0481           write(weighttype(1:80),'(a)') "wrelaxsss"
                0482           call ctrl_set_pack_xy(
                0483      &         cunit, ivartype, fname_relaxsss(ictrlgrad), "maskCtrlC",
                0484      &         weighttype, lxxadxx, mythid)
                0485 #endif
                0486 
                0487 #ifdef ALLOW_PRECIP_CONTROL
                0488           ivartype = 32
                0489           write(weighttype(1:80),'(80a)') ' '
                0490           write(weighttype(1:80),'(a)') "wprecip"
                0491           call ctrl_set_pack_xy(
                0492      &         cunit, ivartype, fname_precip(ictrlgrad), "maskCtrlC",
                0493      &         weighttype, lxxadxx, mythid)
                0494 #endif
                0495 
                0496 #ifdef ALLOW_SWFLUX_CONTROL
                0497           ivartype = 33
                0498           write(weighttype(1:80),'(80a)') ' '
                0499           write(weighttype(1:80),'(a)') "wswflux"
                0500           call ctrl_set_pack_xy(
                0501      &         cunit, ivartype, fname_swflux(ictrlgrad), "maskCtrlC",
                0502      &         weighttype, lxxadxx, mythid)
                0503 #endif
                0504 
                0505 #ifdef ALLOW_SWDOWN_CONTROL
                0506           ivartype = 34
                0507           write(weighttype(1:80),'(80a)') ' '
                0508           write(weighttype(1:80),'(a)') "wswdown"
                0509           call ctrl_set_pack_xy(
                0510      &         cunit, ivartype, fname_swdown(ictrlgrad), "maskCtrlC",
                0511      &         weighttype, lxxadxx, mythid)
                0512 #endif
                0513 
                0514           close ( cunit )
                0515 
                0516         _END_MASTER( mythid )
                0517 
                0518 #endif /* EXCLUDE_CTRL_PACK */
                0519 
                0520       return
e4939baa16 Patr*0521       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!