Changeset 9180 for branches/UKMO
- Timestamp:
- 2018-01-04T15:19:26+01:00 (6 years ago)
- Location:
- branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r8058 r9180 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 :: numtimes_tavg ! No of times to average over 56 67 57 68 !!---------------------------------------------------------------------- … … 81 92 INTEGER :: inum ! File unit number 82 93 REAL(wp) :: zdate ! Date 94 INTEGER :: ierror 83 95 !!----------------------------------------------------------------------- 84 96 85 ! !------------------------------------------- 86 IF( kt == nitbkg_r ) THEN ! Write out background at time step nitbkg_r 87 ! !-----------------------------------======== 97 ! If creating an averaged assim bkg, initialise on first timestep 98 IF ( ln_avgbkg .AND. kt == ( nn_it000 - 1) ) THEN 99 ! Allocate memory 100 ALLOCATE( tn_tavg(jpi,jpj,jpk), STAT=ierror ) 101 IF( ierror > 0 ) THEN 102 CALL ctl_stop( 'asm_wri_bkg: unable to allocate tn_tavg' ) ; RETURN 103 ENDIF 104 tn_tavg(:,:,:)=0 105 ALLOCATE( sn_tavg(jpi,jpj,jpk), STAT=ierror ) 106 IF( ierror > 0 ) THEN 107 CALL ctl_stop( 'asm_wri_bkg: unable to allocate sn_tavg' ) ; RETURN 108 ENDIF 109 sn_tavg(:,:,:)=0 110 ALLOCATE( un_tavg(jpi,jpj,jpk), STAT=ierror ) 111 IF( ierror > 0 ) THEN 112 CALL ctl_stop( 'asm_wri_bkg: unable to allocate un_tavg' ) ; RETURN 113 ENDIF 114 un_tavg(:,:,:)=0 115 ALLOCATE( vn_tavg(jpi,jpj,jpk), STAT=ierror ) 116 IF( ierror > 0 ) THEN 117 CALL ctl_stop( 'asm_wri_bkg: unable to allocate vn_tavg' ) ; RETURN 118 ENDIF 119 vn_tavg(:,:,:)=0 120 ALLOCATE( sshn_tavg(jpi,jpj), STAT=ierror ) 121 IF( ierror > 0 ) THEN 122 CALL ctl_stop( 'asm_wri_bkg: unable to allocate sshn_tavg' ) ; RETURN 123 ENDIF 124 sshn_tavg(:,:)=0 125 #if defined key_zdftke 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 #endif 132 ALLOCATE( avt_tavg(jpi,jpj,jpk), STAT=ierror ) 133 IF( ierror > 0 ) THEN 134 CALL ctl_stop( 'asm_wri_bkg: unable to allocate avt_tavg' ) ; RETURN 135 ENDIF 136 avt_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 avt_tavg(:,:,:) = avt_tavg(:,:,:) + avt(:,:,:) / numtimes_tavg 154 #if defined key_zdftke 155 en_tavg(:,:,:) = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg 156 #endif 157 ENDIF 158 159 160 ! Write out background at time step nitbkg_r or nitavgbkg_r 161 IF ( ( .NOT. ln_avgbkg .AND. (kt == nitbkg_r) ) .OR. & 162 & ( ln_avgbkg .AND. (kt == nitavgbkg_r) ) ) THEN 88 163 ! 89 164 WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) … … 97 172 CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib) 98 173 ! 99 IF( nitbkg_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0 100 zdate = REAL( ndastp ) 101 #if defined key_zdftke 102 ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 103 IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 104 CALL tke_rst( nit000, 'READ' ) ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 105 106 #endif 174 ! 175 ! Write the information 176 IF ( ln_avgbkg ) THEN 177 IF( nitavgbkg_r == nit000 - 1 ) THEN ! Treat special case when nitavgbkg = 0 178 zdate = REAL( ndastp ) 179 #if defined key_zdftke 180 ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 181 IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 182 CALL tke_rst( nit000, 'READ' ) ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 183 184 #endif 185 ELSE 186 zdate = REAL( ndastp ) 187 ENDIF 188 CALL iom_rstput( kt, nitavgbkg_r, inum, 'rdastp' , zdate ) 189 CALL iom_rstput( kt, nitavgbkg_r, inum, 'un' , un_tavg ) 190 CALL iom_rstput( kt, nitavgbkg_r, inum, 'vn' , vn_tavg ) 191 CALL iom_rstput( kt, nitavgbkg_r, inum, 'tn' , tn_tavg ) 192 CALL iom_rstput( kt, nitavgbkg_r, inum, 'sn' , sn_tavg ) 193 CALL iom_rstput( kt, nitavgbkg_r, inum, 'sshn' , sshn_tavg) 194 #if defined key_zdftke 195 CALL iom_rstput( kt, nitavgbkg_r, inum, 'en' , en_tavg ) 196 #endif 197 CALL iom_rstput( kt, nitavgbkg_r, inum, 'avt' , avt_tavg) 198 ! 107 199 ELSE 108 zdate = REAL( ndastp ) 200 IF( nitbkg_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0 201 zdate = REAL( ndastp ) 202 #if defined key_zdftke 203 ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 204 IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 205 CALL tke_rst( nit000, 'READ' ) ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 206 207 #endif 208 ELSE 209 zdate = REAL( ndastp ) 210 ENDIF 211 CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate ) 212 CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un ) 213 CALL iom_rstput( kt, nitbkg_r, inum, 'vn' , vn ) 214 CALL iom_rstput( kt, nitbkg_r, inum, 'tn' , tsn(:,:,:,jp_tem) ) 215 CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) 216 CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , sshn ) 217 #if defined key_zdftke 218 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) 219 #endif 220 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 221 ! 109 222 ENDIF 110 ! 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 ! 223 123 224 CALL iom_close( inum ) 225 124 226 ENDIF 125 227 ! -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r8058 r9180 57 57 #endif 58 58 LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields 59 LOGICAL, PUBLIC :: ln_avgbkg = .FALSE. !: No output of the mean background state fields 59 60 LOGICAL, PUBLIC :: ln_asmiau = .FALSE. !: No applying forcing with an assimilation increment 60 61 LOGICAL, PUBLIC :: ln_asmdin = .FALSE. !: No direct initialization … … 80 81 INTEGER , PUBLIC :: nitiaustr !: Time step of the start of the IAU interval 81 82 INTEGER , PUBLIC :: nitiaufin !: Time step of the end of the IAU interval 83 INTEGER , PUBLIC :: nitavgbkg !: Number of timesteps to average assim bkg [0,nitavgbkg] 82 84 ! 83 85 INTEGER , PUBLIC :: niaufn !: Type of IAU weighing function: = 0 Constant weighting … … 119 121 INTEGER :: iitiaustr_date ! Date YYYYMMDD of IAU interval start time step 120 122 INTEGER :: iitiaufin_date ! Date YYYYMMDD of IAU interval final time step 123 INTEGER :: iitavgbkg_date ! Date YYYYMMDD of end of assim bkg averaging period 121 124 ! 122 125 REAL(wp) :: znorm ! Normalization factor for IAU weights … … 129 132 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv ! 2D workspace 130 133 !! 131 NAMELIST/nam_asminc/ ln_bkgwri, 134 NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg, & 132 135 & ln_trainc, ln_dyninc, ln_sshinc, & 133 136 & ln_asmdin, ln_asmiau, & 134 137 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 135 & ln_salfix, salfixmin, nn_divdmp 138 & ln_salfix, salfixmin, nn_divdmp, nitavgbkg 136 139 !!---------------------------------------------------------------------- 137 140 … … 139 142 ! Read Namelist nam_asminc : assimilation increment interface 140 143 !----------------------------------------------------------------------- 144 145 ! Set default values 146 ln_bkgwri = .FALSE. 147 ln_avgbkg = .FALSE. 148 ln_trainc = .FALSE. 149 ln_dyninc = .FALSE. 150 ln_sshinc = .FALSE. 141 151 ln_seaiceinc = .FALSE. 152 ln_asmdin = .FALSE. 153 ln_asmiau = .TRUE. 154 ln_salfix = .FALSE. 142 155 ln_temnofreeze = .FALSE. 156 salfixmin = -9999 157 nitbkg = 0 158 nitdin = 0 159 nitiaustr = 1 160 nitiaufin = 150 161 niaufn = 0 162 nitavgbkg = 1 143 163 144 164 REWIND( numnam_ref ) ! Namelist nam_asminc in reference namelist : Assimilation increment … … 158 178 WRITE(numout,*) ' Namelist namasm : set assimilation increment parameters' 159 179 WRITE(numout,*) ' Logical switch for writing out background state ln_bkgwri = ', ln_bkgwri 180 WRITE(numout,*) ' Logical switch for writing mean background state ln_avgbkg = ', ln_avgbkg 160 181 WRITE(numout,*) ' Logical switch for applying tracer increments ln_trainc = ', ln_trainc 161 182 WRITE(numout,*) ' Logical switch for applying velocity increments ln_dyninc = ', ln_dyninc … … 168 189 WRITE(numout,*) ' Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 169 190 WRITE(numout,*) ' Timestep of end of IAU interval in [0,nitend-nit000-1] nitiaufin = ', nitiaufin 191 WRITE(numout,*) ' Number of timesteps to average assim bkg [0,nitavgbkg] nitavgbkg = ', nitavgbkg 170 192 WRITE(numout,*) ' Type of IAU weighting function niaufn = ', niaufn 171 193 WRITE(numout,*) ' Logical switch for ensuring that the sa > salfixmin ln_salfix = ', ln_salfix … … 177 199 nitiaustr_r = nitiaustr + nit000 - 1 ! Start of IAU interval referenced to nit000 178 200 nitiaufin_r = nitiaufin + nit000 - 1 ! End of IAU interval referenced to nit000 201 nitavgbkg_r = nitavgbkg + nit000 - 1 ! Averaging period referenced to nit000 179 202 180 203 iiauper = nitiaufin_r - nitiaustr_r + 1 ! IAU interval length … … 186 209 CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date ) ! IAU start time referenced to ndate0 187 210 CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date ) ! IAU end time referenced to ndate0 211 CALL calc_date( nit000, nitavgbkg_r, ndate0, iitavgbkg_date ) ! End of assim bkg averaging period referenced to ndate0 188 212 ! 189 213 IF(lwp) THEN … … 197 221 WRITE(numout,*) ' nitiaustr_r = ', nitiaustr_r 198 222 WRITE(numout,*) ' nitiaufin_r = ', nitiaufin_r 223 WRITE(numout,*) ' nitavgbkg_r = ', nitavgbkg_r 199 224 WRITE(numout,*) 200 225 WRITE(numout,*) ' Dates referenced to current cycle:' … … 206 231 WRITE(numout,*) ' iitiaustr_date = ', iitiaustr_date 207 232 WRITE(numout,*) ' iitiaufin_date = ', iitiaufin_date 233 WRITE(numout,*) ' iitavgbkg_date = ', iitavgbkg_date 208 234 ENDIF 209 235 … … 248 274 & CALL ctl_stop( ' nitdin :', & 249 275 & ' Background time step for Direct Initialization is outside', & 276 & ' the cycle interval') 277 278 IF ( nitavgbkg_r > nitend ) & 279 & CALL ctl_stop( ' nitavgbkg_r :', & 280 & ' Assim bkg averaging period is outside', & 250 281 & ' the cycle interval') 251 282 -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
r8058 r9180 29 29 INTEGER, PUBLIC :: nitiaufin_r !: IAU final time step referenced to nit000 30 30 INTEGER, PUBLIC :: nittrjfrq !: Frequency of trajectory output for 4D-VAR 31 INTEGER, PUBLIC :: nitavgbkg_r !: Averaging period for assim bkg referenced to nit000 31 32 32 33 !!---------------------------------------------------------------------- -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/step.F90
r8561 r9180 336 336 ! Dynamics (tsa used as workspace) 337 337 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 338 339 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields 340 338 341 IF( lk_dynspg_ts ) THEN 339 342 ! revert to previously computed momentum tendencies … … 354 357 IF( lk_asminc .AND. ln_asmiau .AND. & 355 358 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 356 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields357 359 IF( ln_neptsimp ) CALL dyn_nept_cor( kstp ) ! subtract Neptune velocities (simplified) 358 360 IF( lk_bdy ) CALL bdy_dyn3d_dmp(kstp ) ! bdy damping trends
Note: See TracChangeset
for help on using the changeset viewer.