Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/ASM
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/ASM
- Files:
-
- 2 edited
-
asminc.F90 (modified) (7 diffs)
-
asmtrj.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r2715 r3294 21 21 !! ssh_asm_inc : Apply the SSH increment 22 22 !!---------------------------------------------------------------------- 23 USE wrk_nemo ! Memory Allocation 23 24 USE par_oce ! Ocean space and time domain variables 24 25 USE dom_oce ! Ocean space and time domain 25 26 USE oce ! Dynamics and active tracers defined in memory 26 27 USE divcur ! Horizontal divergence and relative vorticity 28 USE ldfdyn_oce ! ocean dynamics: lateral physics 27 29 USE eosbn2 ! Equation of state - in situ and potential density 28 30 USE zpshde ! Partial step : Horizontal Derivative … … 55 57 LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment 56 58 LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 59 INTEGER, PUBLIC :: nn_divdmp = 0 !: Apply divergence damping filter nn_divdmp times 57 60 58 61 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: t_bkg , s_bkg !: Background temperature and salinity … … 76 79 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ssh_bkg, ssh_bkginc ! Background sea surface height and its increment 77 80 81 !! * Substitutions 82 # include "domzgr_substitute.h90" 83 # include "ldfdyn_substitute.h90" 84 # include "vectopt_loop_substitute.h90" 85 78 86 !!---------------------------------------------------------------------- 79 87 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 93 101 !! ** Action : 94 102 !!---------------------------------------------------------------------- 103 !! 104 !! 105 INTEGER :: ji,jj,jk 95 106 INTEGER :: jt 96 107 INTEGER :: imid … … 111 122 REAL(wp) :: zdate_bkg ! Date in background state file for DI 112 123 REAL(wp) :: zdate_inc ! Time axis in increments file 124 125 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv 113 126 !! 114 127 NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri, & … … 116 129 & ln_asmdin, ln_asmiau, & 117 130 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 118 & nittrjfrq, ln_salfix, salfixmin 131 & nittrjfrq, ln_salfix, salfixmin, & 132 & nn_divdmp 119 133 !!---------------------------------------------------------------------- 120 134 … … 420 434 421 435 !----------------------------------------------------------------------- 436 ! Apply divergence damping filter 437 !----------------------------------------------------------------------- 438 439 440 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 441 442 CALL wrk_alloc(jpi,jpj,hdiv) 443 444 DO jt = 1, nn_divdmp 445 446 DO jk = 1, jpkm1 447 448 hdiv(:,:) = 0._wp 449 450 DO jj = 2, jpjm1 451 DO ji = fs_2, fs_jpim1 ! vector opt. 452 hdiv(ji,jj) = & 453 ( e2u(ji ,jj)*fse3u(ji ,jj,jk) * u_bkginc(ji ,jj,jk) & 454 - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk) & 455 + e1v(ji,jj )*fse3v(ji,jj ,jk) * v_bkginc(ji,jj ,jk) & 456 - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk) ) & 457 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 458 END DO 459 END DO 460 461 CALL lbc_lnk( hdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) 462 463 DO jj = 2, jpjm1 464 DO ji = fs_2, fs_jpim1 ! vector opt. 465 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj) & 466 - e1t(ji ,jj)*e2t(ji ,jj) * hdiv(ji ,jj) ) & 467 / e1u(ji,jj) * umask(ji,jj,jk) 468 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1) & 469 - e1t(ji,jj )*e2t(ji,jj ) * hdiv(ji,jj ) ) & 470 / e2v(ji,jj) * vmask(ji,jj,jk) 471 END DO 472 END DO 473 474 END DO 475 476 END DO 477 478 CALL wrk_dealloc(jpi,jpj,hdiv) 479 480 ENDIF 481 482 483 484 !----------------------------------------------------------------------- 422 485 ! Allocate and initialize the background state arrays 423 486 !----------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90
r2399 r3294 105 105 ! 106 106 ! ! Write the information 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' , t n)111 CALL iom_rstput( kt, nitbkg_r, inum, 'sn' , sn)112 CALL iom_rstput( kt, nitbkg_r, inum, 'sshn' , sshn )113 #if defined key_zdftke 114 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en )115 #endif 116 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx )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 ) 113 #if defined key_zdftke 114 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) 115 #endif 116 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 117 117 ! 118 118 CALL iom_close( inum ) … … 143 143 ! 144 144 ! ! Write the information 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' , t n)149 CALL iom_rstput( kt, nitdin_r, inum, 'sn' , sn)150 CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , sshn )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 ) 151 151 ! 152 152 CALL iom_close( inum ) … … 216 216 CALL iom_rstput( it, it, inum, 'un' , un ) 217 217 CALL iom_rstput( it, it, inum, 'vn' , vn ) 218 CALL iom_rstput( it, it, inum, 'tn' , t n)219 CALL iom_rstput( it, it, inum, 'sn' , sn)218 CALL iom_rstput( it, it, inum, 'tn' , tsn(:,:,:,jp_tem) ) 219 CALL iom_rstput( it, it, inum, 'sn' , tsn(:,:,:,jp_sal) ) 220 220 CALL iom_rstput( it, it, inum, 'avmu' , avmu ) 221 221 CALL iom_rstput( it, it, inum, 'avmv' , avmv ) … … 230 230 CALL iom_rstput( it, it, inum, 'avs' , avs ) 231 231 #endif 232 CALL iom_rstput( it, it, inum, 'ta' , t a)233 CALL iom_rstput( it, it, inum, 'sa' , sa)234 CALL iom_rstput( it, it, inum, 'tb' , t b)235 CALL iom_rstput( it, it, inum, 'sb' , sb)236 #if defined key_tradmp 237 CALL iom_rstput( it, it, inum, 'strdmp', strdmp )238 CALL iom_rstput( it, it, inum, 'hmlp' , hmlp )239 #endif 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 240 240 CALL iom_rstput( it, it, inum, 'aeiu' , aeiu ) 241 241 CALL iom_rstput( it, it, inum, 'aeiv' , aeiv )
Note: See TracChangeset
for help on using the changeset viewer.
