Changeset 6762
- Timestamp:
- 2016-06-30T15:45:10+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/NEMO/OPA_SRC/ASM
- Files:
-
- 2 edited
-
asmbkg.F90 (modified) (3 diffs)
-
asminc.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r6761 r6762 50 50 USE ice 51 51 #endif 52 USE asminc, ONLY: ln_avgbkg 52 53 IMPLICIT NONE 53 54 PRIVATE 54 55 55 56 PUBLIC asm_bkg_wri !: Write out the background state 57 58 !! * variables for calculating time means 59 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_tavg , sn_tavg 60 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: un_tavg , vn_tavg 61 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avt_tavg 62 #if defined key_zdfgls || key_zdftke 63 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: en_tavg 64 #endif 65 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:) :: sshn_tavg 66 REAL(wp),SAVE :: gcx_tavg 67 REAL(wp),SAVE :: numtimes_tavg ! No of times to average over 56 68 57 69 !!---------------------------------------------------------------------- … … 83 95 !!----------------------------------------------------------------------- 84 96 85 ! !------------------------------------------- 86 IF( kt == nitbkg_r ) THEN ! Write out background at time step nitbkg_r 87 ! !-----------------------------------======== 97 98 ! If creating an averaged assim bkg, initialise on first timestep 99 IF ( ln_avgbkg .AND. kt == ( nn_it000 - 1) ) THEN 100 ! Allocate memory 101 ALLOCATE( tn_tavg(jpi,jpj,jpk), STAT=ierror ) 102 IF( ierror > 0 ) THEN 103 CALL ctl_stop( 'asm_wri_bkg: unable to allocate tn_tavg' ) ; RETURN 104 ENDIF 105 tn_tavg=0 106 ALLOCATE( sn_tavg(jpi,jpj,jpk), STAT=ierror ) 107 IF( ierror > 0 ) THEN 108 CALL ctl_stop( 'asm_wri_bkg: unable to allocate sn_tavg' ) ; RETURN 109 ENDIF 110 sn_tavg=0 111 ALLOCATE( un_tavg(jpi,jpj,jpk), STAT=ierror ) 112 IF( ierror > 0 ) THEN 113 CALL ctl_stop( 'asm_wri_bkg: unable to allocate un_tavg' ) ; RETURN 114 ENDIF 115 un_tavg=0 116 ALLOCATE( vn_tavg(jpi,jpj,jpk), STAT=ierror ) 117 IF( ierror > 0 ) THEN 118 CALL ctl_stop( 'asm_wri_bkg: unable to allocate vn_tavg' ) ; RETURN 119 ENDIF 120 vn_tavg=0 121 ALLOCATE( ssh_tavg(jpi,jpj), STAT=ierror ) 122 IF( ierror > 0 ) THEN 123 CALL ctl_stop( 'asm_wri_bkg: unable to allocate ssh_tavg' ) ; RETURN 124 ENDIF 125 ssh_tavg=0 126 ALLOCATE( en_tavg(jpi,jpj,jpk), STAT=ierror ) 127 IF( ierror > 0 ) THEN 128 CALL ctl_stop( 'asm_wri_bkg: unable to allocate en_tavg' ) ; RETURN 129 ENDIF 130 en_tavg=0 131 ALLOCATE( avt_tavg(jpi,jpj,jpk), STAT=ierror ) 132 IF( ierror > 0 ) THEN 133 CALL ctl_stop( 'asm_wri_bkg: unable to allocate avt_tavg' ) ; RETURN 134 ENDIF 135 avt_tavg=0 136 gcx_tavg=0 137 138 numtimes_tavg = REAL ( nitavgbkg_r - nn_it000 + 1 ) 139 ENDIF 140 141 ! If creating an averaged assim bkg, sum the contribution every timestep 142 IF ( ln_avgbkg ) THEN 143 IF (lwp) THEN 144 WRITE(numout,*) 'asm_wri_bkg : Summing assim bkg fields at timestep ',kt 145 WRITE(numout,*) '~~~~~~~~~~~~ ' 146 ENDIF 147 148 tn_tavg(:,:,:) = tn_tavg(:,:,:) + tsn(:,:,:,jp_tem) / numtimes_tavg 149 sn_tavg(:,:,:) = sn_tavg(:,:,:) + tsn(:,:,:,jp_sal) / numtimes_tavg 150 sshn_tavg(:,:) = sshn_tavg(:,:) + sshn (:,:) / numtimes_tavg 151 un_tavg(:,:,:) = un_tavg(:,:,:) + un(:,:,:) / numtimes_tavg 152 vn_tavg(:,:,:) = vn_tavg(:,:,:) + vn(:,:,:) / numtimes_tavg 153 gcx_tavg = gcx_tavg + gcx / numtimes_tavg 154 avt_tavg(:,:,:) = avt_tavg(:,:,:) + avt(:,:,:) / numtimes_tavg 155 #if defined key_zdftke 156 en_tavg(:,:,:) = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg 157 #endif 158 ENDIF 159 160 161 ! Write out background at time step nitbkg_r or nitavgbkg_r 162 IF( .NOT. ln_avgbkg .AND. (kt == nitbkg_r) ) .OR. & 163 & ( ln_avgbkg .AND. (kt == nitavgbkg_r) ) THEN 88 164 ! 89 165 WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) … … 109 185 ENDIF 110 186 ! 111 ! ! Write the information 112 CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate ) 113 CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un ) 114 CALL iom_rstput( kt, nitbkg_r, inum, 'vn' , vn ) 115 CALL iom_rstput( kt, nitbkg_r, inum, 'tn' , tsn(:,:,:,jp_tem) ) 116 CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) 117 CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , sshn ) 118 #if defined key_zdftke 119 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) 120 #endif 121 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 122 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 123 ! 187 ! Write the information 188 CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate ) 189 190 IF ( ln_avgbkg ) THEN 191 CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un_tavg ) 192 CALL iom_rstput( kt, nitbkg_r, inum, 'vn' , vn_tavg ) 193 CALL iom_rstput( kt, nitbkg_r, inum, 'tn' , tn_tavg ) 194 CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , sn_tavg ) 195 CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , sshn ) 196 #if defined key_zdftke 197 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en_tavg ) 198 #endif 199 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx_tavg) 200 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt_tavg) 201 ! 202 ELSE 203 CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un ) 204 CALL iom_rstput( kt, nitbkg_r, inum, 'vn' , vn ) 205 CALL iom_rstput( kt, nitbkg_r, inum, 'tn' , tsn(:,:,:,jp_tem) ) 206 CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) 207 CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , sshn ) 208 #if defined key_zdftke 209 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) 210 #endif 211 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 212 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 213 ! 214 ENDIF 215 124 216 CALL iom_close( inum ) 217 125 218 ENDIF 126 219 ! -
branches/UKMO/dev_r5518_25hr_mean_assim_bkg/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r6761 r6762 69 69 #endif 70 70 LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields 71 LOGICAL, PUBLIC :: ln_avgbkg = .FALSE. !: No output of the mean background state fields 71 72 LOGICAL, PUBLIC :: ln_asmiau = .FALSE. !: No applying forcing with an assimilation increment 72 73 LOGICAL, PUBLIC :: ln_asmdin = .FALSE. !: No direct initialization … … 92 93 INTEGER , PUBLIC :: nitiaustr !: Time step of the start of the IAU interval 93 94 INTEGER , PUBLIC :: nitiaufin !: Time step of the end of the IAU interval 95 INTEGER , PUBLIC :: nitavgbkg !: Number of timesteps to average assim bkg [0,nitavgbkg] 94 96 ! 95 97 INTEGER , PUBLIC :: niaufn !: Type of IAU weighing function: = 0 Constant weighting … … 139 141 INTEGER :: iitiaufin_date ! Date YYYYMMDD of IAU interval final time step 140 142 INTEGER :: isurfstat ! Local integer for status of reading surft variable 143 INTEGER :: iitavgbkg_date ! Date YYYYMMDD of end of assim bkg averaging period 141 144 ! 142 145 REAL(wp) :: znorm ! Normalization factor for IAU weights … … 158 161 ! so only apply surft increments. 159 162 !! 160 NAMELIST/nam_asminc/ ln_bkgwri, 163 NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg & 161 164 & ln_trainc, ln_dyninc, ln_sshinc, & 162 165 & ln_asmdin, ln_asmiau, & 163 166 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 164 & ln_salfix, salfixmin, nn_divdmp, mld_choice167 & ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice 165 168 !!---------------------------------------------------------------------- 166 169 … … 171 174 ! Set default values 172 175 ln_bkgwri = .FALSE. 176 ln_avgbkg = .FALSE. 173 177 ln_trainc = .FALSE. 174 178 ln_dyninc = .FALSE. … … 185 189 nitiaufin = 150 186 190 niaufn = 0 191 nitavgbkg = 1 187 192 188 193 REWIND( numnam_ref ) ! Namelist nam_asminc in reference namelist : Assimilation increment … … 202 207 WRITE(numout,*) ' Namelist namasm : set assimilation increment parameters' 203 208 WRITE(numout,*) ' Logical switch for writing out background state ln_bkgwri = ', ln_bkgwri 209 WRITE(numout,*) ' Logical switch for writing mean background state ln_avgbkg = ', ln_avgbkg 204 210 WRITE(numout,*) ' Logical switch for applying tracer increments ln_trainc = ', ln_trainc 205 211 WRITE(numout,*) ' Logical switch for applying velocity increments ln_dyninc = ', ln_dyninc … … 212 218 WRITE(numout,*) ' Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 213 219 WRITE(numout,*) ' Timestep of end of IAU interval in [0,nitend-nit000-1] nitiaufin = ', nitiaufin 220 WRITE(numout,*) ' Number of timesteps to average assim bkg [0,nitavgbkg] nitavgbkg = ', nitavgbkg 214 221 WRITE(numout,*) ' Type of IAU weighting function niaufn = ', niaufn 215 222 WRITE(numout,*) ' Logical switch for ensuring that the sa > salfixmin ln_salfix = ', ln_salfix … … 222 229 nitiaustr_r = nitiaustr + nit000 - 1 ! Start of IAU interval referenced to nit000 223 230 nitiaufin_r = nitiaufin + nit000 - 1 ! End of IAU interval referenced to nit000 231 nitavgbkg_r = nitavgbkg + nit000 - 1 ! Averaging period referenced to nit000 224 232 225 233 iiauper = nitiaufin_r - nitiaustr_r + 1 ! IAU interval length … … 231 239 CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date ) ! IAU start time referenced to ndate0 232 240 CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date ) ! IAU end time referenced to ndate0 241 CALL calc_date( nit000, nitavgbkg_r, ndate0, iitavgbkg_date ) ! End of assim bkg averaging period referenced to ndate0 233 242 ! 234 243 IF(lwp) THEN … … 242 251 WRITE(numout,*) ' nitiaustr_r = ', nitiaustr_r 243 252 WRITE(numout,*) ' nitiaufin_r = ', nitiaufin_r 253 WRITE(numout,*) ' nitavgbkg_r = ', nitavgbkg_r 244 254 WRITE(numout,*) 245 255 WRITE(numout,*) ' Dates referenced to current cycle:' … … 251 261 WRITE(numout,*) ' iitiaustr_date = ', iitiaustr_date 252 262 WRITE(numout,*) ' iitiaufin_date = ', iitiaufin_date 263 WRITE(numout,*) ' iitavgbkg_date = ', iitavgbkg_date 253 264 ENDIF 254 265 … … 293 304 & CALL ctl_stop( ' nitdin :', & 294 305 & ' Background time step for Direct Initialization is outside', & 306 & ' the cycle interval') 307 308 IF ( nitavgbkg_r > nitend ) & 309 & CALL ctl_stop( ' nitavgbkg_r :', & 310 & ' Assim bkg averaging period is outside', & 295 311 & ' the cycle interval') 296 312
Note: See TracChangeset
for help on using the changeset viewer.
