[2128] | 1 | MODULE asmtrj |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE asmtrj *** |
---|
[2399] | 4 | !! Assimilation trajectory interface: Write to file the background state and the model state trajectory |
---|
[2128] | 5 | !!====================================================================== |
---|
[2399] | 6 | !! History : ! 2007-03 (M. Martin) Met. Office version |
---|
| 7 | !! ! 2007-04 (A. Weaver) asm_trj_wri, original code |
---|
| 8 | !! ! 2007-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL |
---|
| 9 | !! ! 2007-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish |
---|
| 10 | !! background states in Jb term and at analysis time. |
---|
| 11 | !! Include state trajectory routine (currently empty) |
---|
| 12 | !! ! 2007-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0 |
---|
| 13 | !! ! 2009-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2 |
---|
| 14 | !! ! 2009-06 (F. Vigilant) asm_trj_wri: special case when kt=nit000-1 |
---|
| 15 | !! ! 2009-07 (F. Vigilant) asm_trj_wri: add computation of eiv at restart |
---|
| 16 | !!---------------------------------------------------------------------- |
---|
[2128] | 17 | |
---|
| 18 | !!---------------------------------------------------------------------- |
---|
| 19 | !! 'key_asminc' : Switch on the assimilation increment interface |
---|
| 20 | !!---------------------------------------------------------------------- |
---|
| 21 | !! asm_bkg_wri : Write out the background state |
---|
| 22 | !! asm_trj_wri : Write out the model state trajectory (used with 4D-Var) |
---|
| 23 | !!---------------------------------------------------------------------- |
---|
| 24 | USE oce ! Dynamics and active tracers defined in memory |
---|
| 25 | USE sbc_oce ! Ocean surface boundary conditions |
---|
| 26 | USE zdf_oce ! Vertical mixing variables |
---|
| 27 | USE zdfddm ! Double diffusion mixing parameterization |
---|
| 28 | USE ldftra_oce ! Lateral tracer mixing coefficient defined in memory |
---|
| 29 | USE ldfslp ! Slopes of neutral surfaces |
---|
| 30 | USE tradmp ! Tracer damping |
---|
| 31 | #if defined key_zdftke |
---|
| 32 | USE zdftke ! TKE vertical physics |
---|
| 33 | #endif |
---|
| 34 | USE eosbn2 ! Equation of state (eos_bn2 routine) |
---|
| 35 | USE zdfmxl ! Mixed layer depth |
---|
[2399] | 36 | USE dom_oce, ONLY : ndastp |
---|
| 37 | USE sol_oce, ONLY : gcx ! Solver variables defined in memory |
---|
| 38 | USE in_out_manager ! I/O manager |
---|
| 39 | USE iom ! I/O module |
---|
| 40 | USE asmpar ! Parameters for the assmilation interface |
---|
| 41 | USE zdfmxl ! mixed layer depth |
---|
[2128] | 42 | #if defined key_traldf_c2d |
---|
[2399] | 43 | USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine) |
---|
[2128] | 44 | #endif |
---|
| 45 | |
---|
| 46 | IMPLICIT NONE |
---|
| 47 | PRIVATE |
---|
[2399] | 48 | |
---|
| 49 | PUBLIC asm_bkg_wri !: Write out the background state |
---|
| 50 | PUBLIC asm_trj_wri !: Write out the background state |
---|
[2128] | 51 | |
---|
[2287] | 52 | !!---------------------------------------------------------------------- |
---|
| 53 | !! NEMO/OPA 3.3 , NEMO Consortium (2010) |
---|
| 54 | !! $Id$ |
---|
[2399] | 55 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
[2287] | 56 | !!---------------------------------------------------------------------- |
---|
[2128] | 57 | CONTAINS |
---|
| 58 | |
---|
| 59 | SUBROUTINE asm_bkg_wri( kt ) |
---|
| 60 | !!----------------------------------------------------------------------- |
---|
| 61 | !! *** ROUTINE asm_bkg_wri *** |
---|
| 62 | !! |
---|
| 63 | !! ** Purpose : Write to file the background state for later use in the |
---|
| 64 | !! inner loop of data assimilation or for direct initialization |
---|
| 65 | !! in the outer loop. |
---|
| 66 | !! |
---|
| 67 | !! ** Method : Write out the background state for use in the Jb term |
---|
| 68 | !! in the cost function and for use with direct initialization |
---|
| 69 | !! at analysis time. |
---|
| 70 | !!----------------------------------------------------------------------- |
---|
| 71 | INTEGER, INTENT( IN ) :: kt ! Current time-step |
---|
[2399] | 72 | ! |
---|
[2128] | 73 | CHARACTER (LEN=50) :: cl_asmbkg |
---|
| 74 | CHARACTER (LEN=50) :: cl_asmdin |
---|
| 75 | LOGICAL :: llok ! Check if file exists |
---|
| 76 | INTEGER :: inum ! File unit number |
---|
| 77 | REAL(wp) :: zdate ! Date |
---|
[2399] | 78 | !!----------------------------------------------------------------------- |
---|
[2128] | 79 | |
---|
[2399] | 80 | ! !------------------------------------------- |
---|
| 81 | IF( kt == nitbkg_r ) THEN ! Write out background at time step nitbkg_r |
---|
| 82 | ! !-----------------------------------======== |
---|
| 83 | ! |
---|
[2128] | 84 | WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) |
---|
| 85 | cl_asmbkg = TRIM( cl_asmbkg ) |
---|
| 86 | INQUIRE( FILE = cl_asmbkg, EXIST = llok ) |
---|
[2399] | 87 | ! |
---|
[2128] | 88 | IF( .NOT. llok ) THEN |
---|
[2399] | 89 | IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg ) |
---|
| 90 | ! |
---|
| 91 | ! ! Define the output file |
---|
[2128] | 92 | CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib) |
---|
[2399] | 93 | ! |
---|
| 94 | IF( nitbkg_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0 |
---|
[2128] | 95 | zdate = REAL( ndastp ) |
---|
| 96 | #if defined key_zdftke |
---|
[2399] | 97 | ! lk_zdftke=T : Read turbulent kinetic energy ( en ) |
---|
[2128] | 98 | IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' |
---|
[2399] | 99 | CALL tke_rst( nit000, 'READ' ) ! lk_zdftke=T : Read turbulent kinetic energy ( en ) |
---|
| 100 | |
---|
[2128] | 101 | #endif |
---|
| 102 | ELSE |
---|
| 103 | zdate = REAL( ndastp ) |
---|
| 104 | ENDIF |
---|
[2399] | 105 | ! |
---|
| 106 | ! ! Write the information |
---|
[2977] | 107 | CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate ) |
---|
| 108 | CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un ) |
---|
| 109 | CALL iom_rstput( kt, nitbkg_r, inum, 'vn' , vn ) |
---|
| 110 | CALL iom_rstput( kt, nitbkg_r, inum, 'tn' , tsn(:,:,:,jp_tem) ) |
---|
| 111 | CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) |
---|
| 112 | CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , sshn ) |
---|
[2128] | 113 | #if defined key_zdftke |
---|
[2977] | 114 | CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) |
---|
[2128] | 115 | #endif |
---|
[2977] | 116 | CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) |
---|
[2399] | 117 | ! |
---|
[2128] | 118 | CALL iom_close( inum ) |
---|
| 119 | ENDIF |
---|
[2399] | 120 | ! |
---|
[2128] | 121 | ENDIF |
---|
| 122 | |
---|
[2399] | 123 | ! !------------------------------------------- |
---|
| 124 | IF( kt == nitdin_r ) THEN ! Write out background at time step nitdin_r |
---|
| 125 | ! !-----------------------------------======== |
---|
| 126 | ! |
---|
[2128] | 127 | WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin ) |
---|
| 128 | cl_asmdin = TRIM( cl_asmdin ) |
---|
| 129 | INQUIRE( FILE = cl_asmdin, EXIST = llok ) |
---|
[2399] | 130 | ! |
---|
[2128] | 131 | IF( .NOT. llok ) THEN |
---|
[2399] | 132 | IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin ) |
---|
| 133 | ! |
---|
| 134 | ! ! Define the output file |
---|
[2128] | 135 | CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib) |
---|
[2399] | 136 | ! |
---|
| 137 | IF( nitdin_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0 |
---|
[2128] | 138 | |
---|
| 139 | zdate = REAL( ndastp ) |
---|
| 140 | ELSE |
---|
| 141 | zdate = REAL( ndastp ) |
---|
| 142 | ENDIF |
---|
[2399] | 143 | ! |
---|
| 144 | ! ! Write the information |
---|
[2977] | 145 | CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate ) |
---|
| 146 | CALL iom_rstput( kt, nitdin_r, inum, 'un' , un ) |
---|
| 147 | CALL iom_rstput( kt, nitdin_r, inum, 'vn' , vn ) |
---|
| 148 | CALL iom_rstput( kt, nitdin_r, inum, 'tn' , tsn(:,:,:,jp_tem) ) |
---|
| 149 | CALL iom_rstput( kt, nitdin_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) |
---|
| 150 | CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , sshn ) |
---|
[2399] | 151 | ! |
---|
[2128] | 152 | CALL iom_close( inum ) |
---|
| 153 | ENDIF |
---|
[2399] | 154 | ! |
---|
[2128] | 155 | ENDIF |
---|
[2399] | 156 | ! |
---|
[2128] | 157 | END SUBROUTINE asm_bkg_wri |
---|
| 158 | |
---|
[2399] | 159 | |
---|
[2128] | 160 | SUBROUTINE asm_trj_wri( kt ) |
---|
| 161 | !!----------------------------------------------------------------------- |
---|
| 162 | !! *** ROUTINE asm_trj_wri *** |
---|
| 163 | !! |
---|
[2399] | 164 | !! ** Purpose : Write to file the model state trajectory for use with 4D-Var. |
---|
[2128] | 165 | !!----------------------------------------------------------------------- |
---|
| 166 | INTEGER, INTENT( IN ) :: kt ! Current time-step |
---|
[2399] | 167 | ! |
---|
[2128] | 168 | INTEGER :: inum ! File unit number |
---|
| 169 | INTEGER :: it |
---|
| 170 | CHARACTER (LEN=50) :: cl_asmtrj |
---|
| 171 | REAL(wp) :: zdate ! Date |
---|
[2399] | 172 | !!----------------------------------------------------------------------- |
---|
[2128] | 173 | |
---|
| 174 | !------------------------------------------------------------------------ |
---|
| 175 | ! Write a single file for each trajectory time step |
---|
| 176 | !------------------------------------------------------------------------ |
---|
[2399] | 177 | IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN |
---|
[2128] | 178 | |
---|
[2399] | 179 | IF( kt == nit000 - 1 ) THEN ! Treat special case when kt = nit000-1 |
---|
| 180 | ! |
---|
[2128] | 181 | #if defined key_zdftke |
---|
| 182 | IF(lwp) WRITE(numout,*) ' Computing zdf_tke coeff. form restart...' |
---|
| 183 | ! Compute the vertical eddy viscosity and diffusivity coefficients |
---|
| 184 | CALL zdf_tke( nit000 ) |
---|
| 185 | #endif |
---|
| 186 | #if defined key_zdfddm |
---|
| 187 | IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...' |
---|
| 188 | ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect) |
---|
| 189 | CALL zdf_ddm( nit000 ) |
---|
| 190 | #endif |
---|
| 191 | IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...' |
---|
| 192 | ! Compute the turbocline depth and the mixed layer depth |
---|
| 193 | CALL zdf_mxl( nit000 ) |
---|
| 194 | #if defined key_ldfslp |
---|
| 195 | IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...' |
---|
[2239] | 196 | CALL bn2( tsb, rn2 ) |
---|
[2128] | 197 | CALL ldf_slp( nit000, rhd, rn2 ) |
---|
| 198 | #endif |
---|
| 199 | #if defined key_traldf_c2d |
---|
| 200 | IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...' |
---|
| 201 | ! Compute eddy induced velocity coefficient |
---|
| 202 | IF( lk_traldf_eiv ) CALL ldf_eiv( nit000 ) |
---|
| 203 | #endif |
---|
[2399] | 204 | ENDIF |
---|
| 205 | ! |
---|
[2128] | 206 | it = kt - nit000 + 1 |
---|
[2399] | 207 | ! |
---|
| 208 | ! ! Define the output file |
---|
[2128] | 209 | WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it |
---|
| 210 | cl_asmtrj = TRIM( cl_asmtrj ) |
---|
| 211 | CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib) |
---|
[2399] | 212 | ! |
---|
| 213 | ! ! Output trajectory fields |
---|
[2128] | 214 | CALL iom_rstput( it, it, inum, 'emp' , emp ) |
---|
| 215 | CALL iom_rstput( it, it, inum, 'emps' , emps ) |
---|
| 216 | CALL iom_rstput( it, it, inum, 'un' , un ) |
---|
| 217 | CALL iom_rstput( it, it, inum, 'vn' , vn ) |
---|
[2977] | 218 | CALL iom_rstput( it, it, inum, 'tn' , tsn(:,:,:,jp_tem) ) |
---|
| 219 | CALL iom_rstput( it, it, inum, 'sn' , tsn(:,:,:,jp_sal) ) |
---|
[2128] | 220 | CALL iom_rstput( it, it, inum, 'avmu' , avmu ) |
---|
| 221 | CALL iom_rstput( it, it, inum, 'avmv' , avmv ) |
---|
| 222 | CALL iom_rstput( it, it, inum, 'avt' , avt ) |
---|
| 223 | #if defined key_ldfslp |
---|
| 224 | CALL iom_rstput( it, it, inum, 'uslp' , uslp ) |
---|
| 225 | CALL iom_rstput( it, it, inum, 'vslp' , vslp ) |
---|
| 226 | CALL iom_rstput( it, it, inum, 'wslpi' , wslpi ) |
---|
| 227 | CALL iom_rstput( it, it, inum, 'wslpj' , wslpj ) |
---|
| 228 | #endif |
---|
| 229 | #if defined key_zdfddm |
---|
| 230 | CALL iom_rstput( it, it, inum, 'avs' , avs ) |
---|
| 231 | #endif |
---|
[2977] | 232 | CALL iom_rstput( it, it, inum, 'ta' , tsa(:,:,:,jp_tem) ) |
---|
| 233 | CALL iom_rstput( it, it, inum, 'sa' , tsa(:,:,:,jp_sal) ) |
---|
| 234 | CALL iom_rstput( it, it, inum, 'tb' , tsb(:,:,:,jp_tem) ) |
---|
| 235 | CALL iom_rstput( it, it, inum, 'sb' , tsb(:,:,:,jp_sal) ) |
---|
| 236 | IF( ln_tradmp ) THEN |
---|
| 237 | CALL iom_rstput( it, it, inum, 'strdmp', strdmp ) |
---|
| 238 | CALL iom_rstput( it, it, inum, 'hmlp' , hmlp ) |
---|
| 239 | END IF |
---|
[2128] | 240 | CALL iom_rstput( it, it, inum, 'aeiu' , aeiu ) |
---|
| 241 | CALL iom_rstput( it, it, inum, 'aeiv' , aeiv ) |
---|
| 242 | CALL iom_rstput( it, it, inum, 'aeiw' , aeiw ) |
---|
[2399] | 243 | ! |
---|
[2128] | 244 | CALL iom_close( inum ) |
---|
| 245 | ENDIF |
---|
[2399] | 246 | ! |
---|
[2128] | 247 | END SUBROUTINE asm_trj_wri |
---|
| 248 | |
---|
[2399] | 249 | !!====================================================================== |
---|
[2128] | 250 | END MODULE asmtrj |
---|