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
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021 implicit none
0022
0023
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
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
0049 integer ilnblnk
0050 external ilnblnk
7109a141b2 Patr*0051
0052
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
0085
9f5240b52a Jean*0086 jmin = 1-OLy
0087 jmax = sNy+OLy
0088 imin = 1-OLx
0089 imax = sNx+OLx
7109a141b2 Patr*0090
0091
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
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
0111
0112
4d72283393 Mart*0113
1a5e3fa960 Patr*0114
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
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
0145
0146
4d72283393 Mart*0147
1a5e3fa960 Patr*0148
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
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
b2cc786f54 Patr*0171
efc45565af Patr*0172
0173
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
bcf343fe85 Patr*0206
85a865b769 Patr*0207 if ( doCtrlUpdate ) then
b2cc786f54 Patr*0208
9f5240b52a Jean*0209 do bj = myByLo(myThid), myByHi(myThid)
0210 do bi = myBxLo(myThid), myBxHi(myThid)
7109a141b2 Patr*0211
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
0226 endif
0227
7109a141b2 Patr*0228
cf1862674e Jean*0229 RETURN
0230 END