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
7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
7109a141b2 Patr*0002 
                0003       subroutine ctrl_get_gen(
                0004      I          xx_gen_file, xx_genstartdate, xx_genperiod,
fae6796590 Jean*0005      I          genmask, genfld, xx_gen0, xx_gen1, xx_gen_dummy,
4bf6063982 Patr*0006      I          xx_gen_remo_intercept, xx_gen_remo_slope,
0ef3606ea7 Gael*0007      I          genweight,
9f5240b52a Jean*0008      I          myTime, myIter, myThid )
7109a141b2 Patr*0009 
                0010 c     ==================================================================
                0011 c     SUBROUTINE ctrl_get_gen
                0012 c     ==================================================================
                0013 c
                0014 c     o new generic routine for reading time dependent control variables
                0015 c       heimbach@mit.edu 12-Jun-2003
                0016 c
                0017 c     ==================================================================
                0018 c     SUBROUTINE ctrl_get_gen
                0019 c     ==================================================================
                0020 
                0021       implicit none
                0022 
                0023 c     == global variables ==
                0024 
                0025 #include "EEPARAMS.h"
                0026 #include "SIZE.h"
                0027 #include "PARAMS.h"
5cf4364659 Mart*0028 #include "CTRL_SIZE.h"
4d72283393 Mart*0029 #include "CTRL.h"
65754df434 Mart*0030 #include "OPTIMCYCLE.h"
7109a141b2 Patr*0031 
                0032 c     == routine arguments ==
                0033       character*(MAX_LEN_FNAM) xx_gen_file
                0034       integer xx_genstartdate(4)
                0035       _RL     xx_genperiod
9f5240b52a Jean*0036       _RS     genmask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0037       _RL     genfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0038       _RL     xx_gen0(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0039       _RL     xx_gen1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
7109a141b2 Patr*0040       _RL     xx_gen_dummy
4bf6063982 Patr*0041       _RL     xx_gen_remo_intercept
                0042       _RL     xx_gen_remo_slope
9f5240b52a Jean*0043       _RL     genweight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0044       _RL     myTime
                0045       integer myIter
                0046       integer myThid
7109a141b2 Patr*0047 
9f5240b52a Jean*0048 c     == external functions ==
                0049       integer  ilnblnk
                0050       external ilnblnk
7109a141b2 Patr*0051 
                0052 c     == local variables ==
                0053       integer bi,bj
7b8b86ab99 Timo*0054       integer i,j
7109a141b2 Patr*0055       integer jmin,jmax
                0056       integer imin,imax
                0057       integer ilgen
                0058 
bcf343fe85 Patr*0059       _RL     gensign
7109a141b2 Patr*0060       _RL     genfac
85a865b769 Patr*0061       logical doCtrlUpdate
7109a141b2 Patr*0062       logical genfirst
                0063       logical genchanged
                0064       integer gencount0
                0065       integer gencount1
                0066 
                0067       logical doglobalread
                0068       logical ladinit
                0069 
de57a2ec4b Mart*0070       character*(MAX_LEN_FNAM) fnamegen
9f5240b52a Jean*0071 #if ( defined ALLOW_SMOOTH && defined ALLOW_SMOOTH_CTRL2D )
de57a2ec4b Mart*0072       character*(MAX_LEN_FNAM) fnamegeneric
9f5240b52a Jean*0073 #endif
1df1712bf3 Ian *0074       character*(MAX_LEN_FNAM) xx_tauu_file
                0075       character*(MAX_LEN_FNAM) xx_tauv_file
                0076       character*(MAX_LEN_FNAM) xx_aqh_file
                0077       character*(MAX_LEN_FNAM) xx_atemp_file
                0078       character*(MAX_LEN_FNAM) xx_precip_file
                0079       character*(MAX_LEN_FNAM) xx_lwdown_file
                0080       character*(MAX_LEN_FNAM) xx_swdown_file
7109a141b2 Patr*0081 
f9d7cbfb72 Ou W*0082       INTEGER il
                0083 
7109a141b2 Patr*0084 c     == end of interface ==
                0085 
9f5240b52a Jean*0086       jmin = 1-OLy
                0087       jmax = sNy+OLy
                0088       imin = 1-OLx
                0089       imax = sNx+OLx
7109a141b2 Patr*0090 
                0091 c--   Now, read the control vector.
                0092       doglobalread = .false.
                0093       ladinit      = .false.
f9d7cbfb72 Ou W*0094       il   =ilnblnk( ctrlDir )
7109a141b2 Patr*0095 
cf705a6c8e Mart*0096       if ( optimcycle .ge. 0 ) then
8705803e2f Gael*0097         ilgen=ilnblnk( xx_gen_file )
f9d7cbfb72 Ou W*0098         write(fnamegen,'(2a,i10.10)')
                0099      &    ctrlDir(1:il)//xx_gen_file(1:ilgen),'.effective.',optimcycle
8705803e2f Gael*0100       endif
                0101 
7109a141b2 Patr*0102 c--   Get the counters, flags, and the interpolation factor.
                0103       call ctrl_get_gen_rec(
79ee6da03d Mart*0104      I                       xx_genstartdate, xx_genperiod,
                0105      O                       genfac, genfirst, genchanged,
                0106      O                       gencount0,gencount1,
4d72283393 Mart*0107      I                       myTime, myIter, myThid )
7109a141b2 Patr*0108 
                0109       if ( genfirst ) then
1a5e3fa960 Patr*0110 cc#ifdef ALLOW_OPENAD
                0111 cc        call oad_active_read_xy( fnamegen, xx_gen1, gencount0,
                0112 cc     &                       doglobalread, ladinit, optimcycle,
4d72283393 Mart*0113 cc     &                       myThid, xx_gen_dummy )
1a5e3fa960 Patr*0114 cc#else
1c8d09be4c Gael*0115 #ifdef ALLOW_AUTODIFF
5f8164fae8 Patr*0116         call active_read_xy( fnamegen, xx_gen1, gencount0,
7109a141b2 Patr*0117      &                       doglobalread, ladinit, optimcycle,
4d72283393 Mart*0118      &                       myThid, xx_gen_dummy )
1df1712bf3 Ian *0119        if (.false.) then
1ad314849b Dani*0120         call active_read_xy( fnamegen, xx_gen0, gencount0,
                0121      &                       doglobalread, ladinit, optimcycle,
4d72283393 Mart*0122      &                       myThid, xx_gen_dummy )
1df1712bf3 Ian *0123        endif
1c8d09be4c Gael*0124 #else
1df1712bf3 Ian *0125         CALL READ_REC_XY_RL( fnamegen, xx_gen1, gencount0, 1, myThid )
1c8d09be4c Gael*0126 #endif
1a5e3fa960 Patr*0127 cc#endif /* ALLOW_OPENAD */
61a813cf9a Gael*0128 
94abde9edf Gael*0129 #ifdef ALLOW_SMOOTH
                0130 #ifdef ALLOW_SMOOTH_CTRL2D
4d72283393 Mart*0131         if (useSMOOTH) call smooth2D(xx_gen1,genmask,1,myThid)
f9d7cbfb72 Ou W*0132         write(fnamegeneric,'(2a,i10.10)')
                0133      &    ctrlDir(1:il)//xx_gen_file(1:ilgen),'.smooth.',optimcycle
c7de4e3cb2 antn*0134         CALL WRITE_REC_3D_RL( fnamegeneric, ctrlprec, 1,
4d72283393 Mart*0135      &             xx_gen1, gencount1, optimcycle, myThid )
94abde9edf Gael*0136 #endif /* ALLOW_SMOOTH_CTRL2D */
                0137 #endif /* ALLOW_SMOOTH */
                0138 
cf705a6c8e Mart*0139         endif
7109a141b2 Patr*0140 
                0141       if (( genfirst ) .or. ( genchanged )) then
4d72283393 Mart*0142         call CTRL_SWAPFFIELDS( xx_gen0, xx_gen1, myThid )
7109a141b2 Patr*0143 
1a5e3fa960 Patr*0144 cc#ifdef ALLOW_OPENAD
                0145 cc        call oad_active_read_xy( fnamegen, xx_gen1 , gencount1,
                0146 cc     &                       doglobalread, ladinit, optimcycle,
4d72283393 Mart*0147 cc     &                       myThid, xx_gen_dummy )
1a5e3fa960 Patr*0148 cc#else
1c8d09be4c Gael*0149 #ifdef ALLOW_AUTODIFF
5f8164fae8 Patr*0150         call active_read_xy( fnamegen, xx_gen1 , gencount1,
7109a141b2 Patr*0151      &                       doglobalread, ladinit, optimcycle,
4d72283393 Mart*0152      &                       myThid, xx_gen_dummy )
1c8d09be4c Gael*0153 #else
                0154         CALL READ_REC_XY_RL( fnamegen, xx_gen1, gencount1, 1, myThid )
                0155 #endif
1a5e3fa960 Patr*0156 cc#endif /* ALLOW_OPENAD */
9ac210f65e Matt*0157 
94abde9edf Gael*0158 #ifdef ALLOW_SMOOTH
                0159 #ifdef ALLOW_SMOOTH_CTRL2D
4d72283393 Mart*0160         if (useSMOOTH) call smooth2D(xx_gen1,genmask,1,myThid)
f9d7cbfb72 Ou W*0161         write(fnamegeneric,'(2a,i10.10)')
                0162      &     ctrlDir(1:il)//xx_gen_file(1:ilgen),'.smooth.',optimcycle
c7de4e3cb2 antn*0163         CALL WRITE_REC_3D_RL( fnamegeneric, ctrlprec, 1,
4d72283393 Mart*0164      &             xx_gen1, gencount0, optimcycle, myThid )
94abde9edf Gael*0165 #endif /* ALLOW_SMOOTH_CTRL2D */
                0166 #endif /* ALLOW_SMOOTH */
                0167 
7109a141b2 Patr*0168       endif
                0169 
                0170 c--   Add control to model variable.
b2cc786f54 Patr*0171 cph(
efc45565af Patr*0172 cph this flag ported from the SIO code
                0173 cph Initial wind stress adjustments are too vigorous.
2e2dc16787 Gael*0174 
                0175       xx_tauu_file       = 'xx_tauu'
                0176       xx_tauv_file       = 'xx_tauv'
1df1712bf3 Ian *0177       xx_aqh_file        = 'xx_aqh'
                0178       xx_atemp_file      = 'xx_atemp'
                0179       xx_precip_file     = 'xx_precip'
                0180       xx_lwdown_file     = 'xx_lwdown'
                0181       xx_swdown_file     = 'xx_swdown'
2e2dc16787 Gael*0182 
1df1712bf3 Ian *0183       if ( gencount0 .LE. 2 .AND. (
                0184 #ifdef CTRL_SKIP_FIRST_TWO_ATM_REC_ALL
                0185      &       xx_gen_file(1:6) .EQ. xx_aqh_file  .OR.
                0186      &       xx_gen_file(1:8) .EQ. xx_atemp_file .OR.
                0187      &       xx_gen_file(1:9) .EQ. xx_precip_file .OR.
                0188      &       xx_gen_file(1:9) .EQ. xx_lwdown_file .OR.
                0189      &       xx_gen_file(1:9) .EQ. xx_swdown_file .OR.
                0190 #endif
                0191      &       xx_gen_file(1:7) .EQ. xx_tauu_file .OR.
6b2230d510 Ou W*0192      &       xx_gen_file(1:7) .EQ. xx_tauv_file ) .AND.
1df1712bf3 Ian *0193      &     ( xx_genperiod .NE. zeroRL ) ) then
85a865b769 Patr*0194          doCtrlUpdate = .FALSE.
2e2dc16787 Gael*0195       else
                0196          doCtrlUpdate = .TRUE.
85a865b769 Patr*0197       endif
6b2230d510 Ou W*0198       if ( xx_gen_file(1:7) .EQ. xx_tauu_file .OR.
                0199      &     xx_gen_file(1:7) .EQ. xx_tauv_file ) then
bcf343fe85 Patr*0200          gensign = -1.
2e2dc16787 Gael*0201       else
                0202          gensign = 1.
bcf343fe85 Patr*0203       endif
2e2dc16787 Gael*0204 
85a865b769 Patr*0205 cph since the above is ECCO specific, we undo it here:
bcf343fe85 Patr*0206 cph      doCtrlUpdate = .TRUE.
85a865b769 Patr*0207       if ( doCtrlUpdate ) then
b2cc786f54 Patr*0208 cph)
9f5240b52a Jean*0209        do bj = myByLo(myThid), myByHi(myThid)
                0210         do bi = myBxLo(myThid), myBxHi(myThid)
7109a141b2 Patr*0211 c--       Calculate mask for tracer cells (0 => land, 1 => water).
9f5240b52a Jean*0212           do j = 1,sNy
                0213             do i = 1,sNx
7109a141b2 Patr*0214               genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
bcf343fe85 Patr*0215      &              + gensign*genfac            *xx_gen0(i,j,bi,bj)
                0216      &              + gensign*(1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)
fae6796590 Jean*0217               genfld(i,j,bi,bj) =
7b8b86ab99 Timo*0218      &             genmask(i,j,bi,bj)*( genfld (i,j,bi,bj) -
4bf6063982 Patr*0219      &             ( xx_gen_remo_intercept +
9f5240b52a Jean*0220      &               xx_gen_remo_slope*(myTime-starttime) ) )
7109a141b2 Patr*0221             enddo
                0222           enddo
                0223         enddo
9f5240b52a Jean*0224        enddo
b2cc786f54 Patr*0225 cph(
                0226       endif
                0227 cph)
7109a141b2 Patr*0228 
cf1862674e Jean*0229       RETURN
                0230       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!