Back to home page

MITgcm
 
 

    

File indexing completed on 2024-03-02 06:10:18 UTC

view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
bbd125616c Gael*0001 c ----------------------------------------------------------------
                0002 c --- ctrl_cost_gen2d
                0003 c --- ctrl_cost_gen3d
                0004 c ----------------------------------------------------------------
                0005 
8717a37129 Gael*0006 #include "CTRL_OPTIONS.h"
                0007 
96a95c13e5 Gael*0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 CBOP
                0010 C     !ROUTINE: ctrl_cost_gen2d
                0011 C     !INTERFACE:
8717a37129 Gael*0012       subroutine ctrl_cost_gen2d(
                0013      I                       startrec,
                0014      I                       endrec,
                0015      I                       xx_gen_file,
                0016      I                       xx_gen_dummy,
                0017      I                       xx_gen_period,
bbd125616c Gael*0018      I                       xx_gen_weight,
f127287d37 Gael*0019      I                       dodimensionalcost,
8717a37129 Gael*0020      O                       num_gen_anom,
                0021      O                       objf_gen_anom,
7b8b86ab99 Timo*0022      I                       xx_gen_mask2D,
9f5240b52a Jean*0023      I                       myThid )
8717a37129 Gael*0024 
96a95c13e5 Gael*0025 C     !DESCRIPTION: \bv
                0026 C     Generic routine for all 2D control penalty terms
                0027 C     \ev
8717a37129 Gael*0028 
                0029       implicit none
                0030 
                0031 c     == global variables ==
                0032 
                0033 #include "EEPARAMS.h"
                0034 #include "SIZE.h"
                0035 #include "PARAMS.h"
                0036 #include "GRID.h"
                0037 
84f053a743 Gael*0038 #ifdef ALLOW_CTRL
5cf4364659 Mart*0039 # include "CTRL_SIZE.h"
4d72283393 Mart*0040 # include "CTRL.h"
65754df434 Mart*0041 # include "OPTIMCYCLE.h"
84f053a743 Gael*0042 #endif
8717a37129 Gael*0043 
                0044 c     == routine arguments ==
                0045 
                0046       integer startrec
                0047       integer endrec
                0048       character*(MAX_LEN_FNAM) xx_gen_file
                0049       _RL xx_gen_dummy
                0050       _RL xx_gen_period
9f5240b52a Jean*0051       _RL xx_gen_weight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
f127287d37 Gael*0052       logical dodimensionalcost
9f5240b52a Jean*0053       _RL num_gen_anom(nSx,nSy)
                0054       _RL objf_gen_anom(nSx,nSy)
                0055       _RS xx_gen_mask2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
84f053a743 Gael*0056       integer myThid
                0057 
                0058 #ifdef ALLOW_CTRL
8717a37129 Gael*0059 
                0060 c     == local variables ==
                0061 
                0062       integer bi,bj
9f5240b52a Jean*0063       integer i, j
8717a37129 Gael*0064       integer itlo,ithi
                0065       integer jtlo,jthi
                0066       integer jmin,jmax
                0067       integer imin,imax
                0068       integer nrec
                0069       integer irec
f9d7cbfb72 Ou W*0070       integer ilfld,ilDir
8717a37129 Gael*0071 
                0072       _RL fctile
                0073       _RL tmpx
                0074       _RL lengthscale
                0075 
9f5240b52a Jean*0076       _RL tmpfld2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,   nSx,nSy)
8717a37129 Gael*0077 
                0078       logical doglobalread
                0079       logical ladinit
                0080 
de57a2ec4b Mart*0081       character*(MAX_LEN_FNAM) fnamefld
8717a37129 Gael*0082 
                0083 c     == external functions ==
                0084 
                0085       integer  ilnblnk
                0086       external ilnblnk
                0087 
96a95c13e5 Gael*0088 CEOP
8717a37129 Gael*0089 
9f5240b52a Jean*0090       jtlo = myByLo(myThid)
                0091       jthi = myByHi(myThid)
                0092       itlo = myBxLo(myThid)
                0093       ithi = myBxHi(myThid)
8717a37129 Gael*0094       jmin = 1
9f5240b52a Jean*0095       jmax = sNy
8717a37129 Gael*0096       imin = 1
9f5240b52a Jean*0097       imax = sNx
8717a37129 Gael*0098 
                0099       lengthscale = 1. _d 0
                0100 
                0101 c--   Read state record from global file.
                0102       doglobalread = .false.
                0103       ladinit      = .false.
                0104 
f9d7cbfb72 Ou W*0105 c--   Number of records to be used.
8717a37129 Gael*0106       nrec = endrec-startrec+1
                0107 
f9d7cbfb72 Ou W*0108 c--   Find ctrlDir length
                0109       ilDir=ilnblnk( ctrlDir )
                0110 
7c50f07931 Mart*0111       do bj = jtlo,jthi
                0112        do bi = itlo,ithi
9f5240b52a Jean*0113         do j = 1-OLy,sNy+OLy
                0114          do i = 1-OLx,sNx+OLx
7c50f07931 Mart*0115           tmpfld2d(i,j,bi,bj) = 0. _d 0
                0116          enddo
                0117         enddo
                0118        enddo
                0119       enddo
                0120 
8717a37129 Gael*0121       if (optimcycle .ge. 0) then
                0122         ilfld=ilnblnk( xx_gen_file )
f9d7cbfb72 Ou W*0123         write(fnamefld,'(2a,i10.10)')
                0124      &       ctrlDir(1:ilDir)//xx_gen_file(1:ilfld),'.',optimcycle
8717a37129 Gael*0125       endif
                0126 
                0127 c--   >>> Loop 1 to compute mean forcing:
                0128       do bj = jtlo,jthi
                0129         do bi = itlo,ithi
989cdae9b6 Gael*0130           num_gen_anom(bi,bj)  = 0. _d 0
                0131           objf_gen_anom(bi,bj) = 0. _d 0
8717a37129 Gael*0132         enddo
                0133       enddo
                0134 
f127287d37 Gael*0135 c--   >>> Loop over records.
b938a3c63b antn*0136       do irec = startrec,endrec
f127287d37 Gael*0137 
                0138 #ifdef ALLOW_AUTODIFF
                0139         call active_read_xy(
                0140      &        fnamefld, tmpfld2d, irec, doglobalread,
                0141      &        ladinit, optimcycle, myThid, xx_gen_dummy )
                0142 #else
                0143         CALL READ_REC_XY_RL( fnamefld, tmpfld2d, iRec, 1, myThid )
                0144 #endif
                0145 
                0146 c--     Loop over this thread tiles.
                0147         do bj = jtlo,jthi
                0148           do bi = itlo,ithi
                0149 
                0150 c--         Determine the weights to be used.
                0151             fctile = 0. _d 0
                0152             do j = jmin,jmax
                0153               do i = imin,imax
7b8b86ab99 Timo*0154                 if (xx_gen_mask2D(i,j,bi,bj) .ne. 0. _d 0) then
f127287d37 Gael*0155 
                0156                 tmpx = tmpfld2d(i,j,bi,bj)
                0157                 IF ( dodimensionalcost ) THEN
                0158                   fctile = fctile + xx_gen_weight(i,j,bi,bj)*tmpx*tmpx
                0159                 ELSE
                0160                   fctile = fctile + tmpx*tmpx
                0161                 ENDIF
                0162                 if ( xx_gen_weight(i,j,bi,bj) .ne. 0. _d 0 )
                0163      &            num_gen_anom(bi,bj) = num_gen_anom(bi,bj)
                0164      &            + 1. _d 0
                0165                 endif
                0166 
                0167               enddo
                0168             enddo
                0169 
                0170             objf_gen_anom(bi,bj) = objf_gen_anom(bi,bj) + fctile
                0171 
                0172           enddo
                0173         enddo
                0174 
                0175 c--   End of loop over records.
                0176       enddo
                0177 
989cdae9b6 Gael*0178 #endif /* ALLOW_CTRL */
84f053a743 Gael*0179 
8717a37129 Gael*0180       return
                0181       end
                0182 
96a95c13e5 Gael*0183 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0184 CBOP
                0185 C     !ROUTINE: ctrl_cost_gen3d
                0186 C     !INTERFACE:
bbd125616c Gael*0187       subroutine ctrl_cost_gen3d(
                0188      I                       xx_gen_file,
                0189      I                       xx_gen_dummy,
                0190      I                       xx_gen_weight,
f127287d37 Gael*0191      I                       dodimensionalcost,
bbd125616c Gael*0192      O                       num_gen,
                0193      O                       objf_gen,
                0194      I                       xx_gen_mask,
9f5240b52a Jean*0195      I                       myThid )
bbd125616c Gael*0196 
96a95c13e5 Gael*0197 C     !DESCRIPTION: \bv
                0198 C     Generic routine for all 3D control penalty terms
                0199 C     \ev
bbd125616c Gael*0200 
                0201       implicit none
                0202 
                0203 c     == global variables ==
                0204 
                0205 #include "EEPARAMS.h"
                0206 #include "SIZE.h"
                0207 #include "PARAMS.h"
                0208 #include "GRID.h"
                0209 
                0210 #ifdef ALLOW_CTRL
5cf4364659 Mart*0211 # include "CTRL_SIZE.h"
4d72283393 Mart*0212 # include "CTRL.h"
65754df434 Mart*0213 # include "OPTIMCYCLE.h"
bbd125616c Gael*0214 #endif
                0215 
                0216 c     == routine arguments ==
                0217 
                0218       character*(MAX_LEN_FNAM) xx_gen_file
                0219       _RL xx_gen_dummy
9f5240b52a Jean*0220       _RL xx_gen_weight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
f127287d37 Gael*0221       logical dodimensionalcost
9f5240b52a Jean*0222       _RL num_gen(nSx,nSy)
                0223       _RL objf_gen(nSx,nSy)
                0224       _RS xx_gen_mask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
bbd125616c Gael*0225       INTEGER myThid
                0226 
                0227 #ifdef ALLOW_CTRL
                0228 
                0229 c     == local variables ==
                0230 
                0231       integer bi,bj
                0232       integer i,j,k
                0233       integer itlo,ithi
                0234       integer jtlo,jthi
                0235       integer jmin,jmax
                0236       integer imin,imax
                0237       integer irec
f9d7cbfb72 Ou W*0238       integer ilfld,ilDir
bbd125616c Gael*0239 
                0240       _RL tmpx
                0241 
                0242       logical doglobalread
                0243       logical ladinit
9f5240b52a Jean*0244       _RL     tmpfld3d(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
bbd125616c Gael*0245 
de57a2ec4b Mart*0246       character*(MAX_LEN_FNAM) fnamefld
bbd125616c Gael*0247 
                0248 c     == external functions ==
                0249 
                0250       integer  ilnblnk
                0251       external ilnblnk
                0252 
96a95c13e5 Gael*0253 CEOP
bbd125616c Gael*0254 
9f5240b52a Jean*0255       jtlo = myByLo(myThid)
                0256       jthi = myByHi(myThid)
                0257       itlo = myBxLo(myThid)
                0258       ithi = myBxHi(myThid)
bbd125616c Gael*0259       jmin = 1
9f5240b52a Jean*0260       jmax = sNy
bbd125616c Gael*0261       imin = 1
9f5240b52a Jean*0262       imax = sNx
bbd125616c Gael*0263 
                0264 c--   Read state record from global file.
                0265       doglobalread = .false.
                0266       ladinit      = .false.
                0267 
f9d7cbfb72 Ou W*0268 c--   Find ctrlDir length
                0269       ilDir=ilnblnk( ctrlDir )
                0270 
7c50f07931 Mart*0271       do bj = jtlo,jthi
                0272        do bi = itlo,ithi
9f5240b52a Jean*0273         do k = 1,Nr
                0274          do j = 1-OLy,sNy+OLy
                0275           do i = 1-OLx,sNx+OLx
7c50f07931 Mart*0276            tmpfld3d(i,j,k,bi,bj) = 0. _d 0
                0277           enddo
                0278          enddo
                0279         enddo
                0280        enddo
                0281       enddo
                0282 
bbd125616c Gael*0283       if (optimcycle .ge. 0) then
                0284         ilfld = ilnblnk( xx_gen_file )
f9d7cbfb72 Ou W*0285         write(fnamefld,'(2a,i10.10)')
                0286      &       ctrlDir(1:ilDir)//xx_gen_file(1:ilfld),'.',optimcycle
bbd125616c Gael*0287       endif
                0288 
                0289 c--   >>> Loop 1 to compute mean forcing:
                0290       do bj = jtlo,jthi
                0291         do bi = itlo,ithi
                0292           num_gen(bi,bj)  = 0. _d 0
                0293           objf_gen(bi,bj) = 0. _d 0
                0294         enddo
                0295       enddo
                0296 
f127287d37 Gael*0297       irec = 1
                0298 
1c8d09be4c Gael*0299 #ifdef ALLOW_AUTODIFF
f9d7cbfb72 Ou W*0300       call active_read_xyz(
                0301      &      fnamefld, tmpfld3d, irec, doglobalread,
                0302      &      ladinit, optimcycle, myThid, xx_gen_dummy )
1c8d09be4c Gael*0303 #else
f9d7cbfb72 Ou W*0304       CALL READ_REC_XYZ_RL( fnamefld, tmpfld3d, iRec, 1, myThid )
1c8d09be4c Gael*0305 #endif
bbd125616c Gael*0306 
f9d7cbfb72 Ou W*0307 c--   Loop over this thread tiles.
                0308       do bj = jtlo,jthi
                0309         do bi = itlo,ithi
bbd125616c Gael*0310 
f9d7cbfb72 Ou W*0311           num_gen(bi,bj)  = 0. _d 0
                0312           objf_gen(bi,bj) = 0. _d 0
bbd125616c Gael*0313 
f9d7cbfb72 Ou W*0314           do k = 1,Nr
bbd125616c Gael*0315             do j = jmin,jmax
                0316               do i = imin,imax
96a95c13e5 Gael*0317                 if (xx_gen_mask(i,j,k,bi,bj) .ne. 0. _d 0) then
bbd125616c Gael*0318                   tmpx = tmpfld3d(i,j,k,bi,bj)
f127287d37 Gael*0319                 IF ( dodimensionalcost ) THEN
bbd125616c Gael*0320                   objf_gen(bi,bj) = objf_gen(bi,bj)
                0321      &                 + xx_gen_weight(i,j,k,bi,bj)
                0322      &                 *tmpx*tmpx
f127287d37 Gael*0323                 ELSE
bbd125616c Gael*0324                   objf_gen(bi,bj) = objf_gen(bi,bj) + tmpx*tmpx
f127287d37 Gael*0325                 ENDIF
                0326                 if ( xx_gen_weight(i,j,k,bi,bj) .ne. 0. _d 0 )
                0327      &            num_gen(bi,bj) = num_gen(bi,bj) + 1. _d 0
bbd125616c Gael*0328                 endif
                0329               enddo
                0330             enddo
                0331           enddo
f9d7cbfb72 Ou W*0332 
bbd125616c Gael*0333         enddo
f9d7cbfb72 Ou W*0334       enddo
bbd125616c Gael*0335 
cf705a6c8e Mart*0336 #endif /* ALLOW_CTRL */
bbd125616c Gael*0337 
                0338       return
                0339       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!