- Timestamp:
- 2016-06-30T15:45:10+02:00 (8 years ago)
- File:
-
- 1 edited
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 !
Note: See TracChangeset
for help on using the changeset viewer.
