Changeset 460
- Timestamp:
- 2006-05-10T19:10:25+02:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DIA
- Files:
-
- 5 edited
-
diadimg.F90 (modified) (1 diff)
-
diagap.F90 (modified) (2 diffs)
-
diahdy.F90 (modified) (7 diffs)
-
diaptr.F90 (modified) (14 diffs)
-
diawri.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diadimg.F90
r247 r460 84 84 85 85 CASE ( 'T') 86 z4dep(:)= fsdept(1,1,:)86 z4dep(:)=gdept_0(:) 87 87 88 88 CASE ( 'W' ) 89 z4dep(:)= fsdepw(1,1,:)89 z4dep(:)=gdepw_0(:) 90 90 91 91 CASE ( '2' ) -
trunk/NEMO/OPA_SRC/DIA/diagap.F90
r352 r460 31 31 !! * Module variables 32 32 INTEGER :: & 33 !??? numgap, & ! logical unit for differences diagnostic34 33 ngap , & ! time step frequency 35 34 nprg ! switch for control print … … 171 170 ! Vertical grids : gdept, gdepw 172 171 CALL histvert( numgap, "deptht", "Vertical T levels", & 173 "m", jpk, gdept , ndepidg )172 "m", jpk, gdept_0, ndepidg ) 174 173 175 174 ! define fields to be stored -
trunk/NEMO/OPA_SRC/DIA/diahdy.F90
r247 r460 107 107 IF(lwp) WRITE(numout,*) 'dia_hdy : computation of dynamical heigh' 108 108 IF(lwp) WRITE(numout,*) '~~~~~~~' 109 # if defined key_s_coord || defined key_partial_steps 110 ! Dynamic height diagnostics not yet implemented 111 IF(lwp) WRITE(numout,cform_err) 112 IF(lwp) WRITE(numout,*) ' key_s_coord or key_partial_steps used' 113 IF(lwp) WRITE(numout,*) ' Dynamical height diagnostics not yet implemented' 114 nstop = nstop + 1 115 # endif 116 117 DO jk = 1, jpk 118 IF( fsdepw(1,1,jk) > zgdsup ) GOTO 110 109 IF( .NOT. ln_zco ) THEN ! Dynamic height diagnostics only implemented in z-coordinate 110 IF(lwp) WRITE(numout,cform_err) 111 IF(lwp) WRITE(numout,*) ' ln_zps or ln_sco, Dynamical height diagnostics not yet implemented' 112 nstop = nstop + 1 113 ENDIF 114 DO jk = 1, jpk 115 IF( gdepw_0(jk) > zgdsup ) GOTO 110 119 116 END DO 120 117 IF(lwp) WRITE(numout,*)'problem zgdsup greater than gdepw(jpk)' … … 126 123 ! Interpolation coefficients for zgdsup-gdepw(ihdsup) layer 127 124 128 za = fsdepw(1,1,ihdsup )129 zb = fsdepw(1,1,ihdsup+1)125 za = gdepw_0(ihdsup ) 126 zb = gdepw_0(ihdsup+1) 130 127 IF( za > zgdsup .OR. zb < zgdsup ) THEN 131 128 IF(lwp) WRITE(numout,*) za, zb, ihdsup, zgdsup … … 140 137 DO jk = 1, jpk 141 138 zp = 0.e0 142 zh = fsdept(1,1,jk)139 zh = gdept_0(jk) 143 140 zt = 0.e0 144 141 zs = 35. … … 181 178 zs = 35. 182 179 zsr= zwky(jk) 183 zh = fsdept(1,1,jk)180 zh = gdept_0(jk) 184 181 185 182 ze = ( 9.1697e-11*zt+2.0816e-9 ) *zt-9.9348e-8 … … 231 228 DO jj = 1, jpj 232 229 DO ji = 1, jpi 233 zhd = zfacto * zciint * fse3t(ji,jj,ik) * zsva(ji,jj,ik)230 zhd = zfacto * zciint * e3t_0(ik) * zsva(ji,jj,ik) 234 231 hdy(ji,jj,ik) = zhd * tmask(ji,jj,ik) * tmask(ji,jj,ik-1) 235 232 END DO … … 241 238 DO jj = 1, jpj 242 239 DO ji = 1, jpi 243 zhd = hdy(ji,jj,jk+1) + zfacto * fse3t(ji,jj,jk) * zsva(ji,jj,jk)240 zhd = hdy(ji,jj,jk+1) + zfacto * e3t_0(jk) * zsva(ji,jj,jk) 244 241 hdy(ji,jj,jk) = zhd * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 245 242 END DO … … 252 249 DO jj = 1, jpj 253 250 DO ji = 1, jpi 254 zhd = hdy(ji,jj,ik+1) + zfacto * fse3t(ji,jj,ik) * zsva(ji,jj,ik)251 zhd = hdy(ji,jj,ik+1) + zfacto * e3t_0(ik) * zsva(ji,jj,ik) 255 252 hdy(ji,jj,ik) = zhd * tmask(ji,jj,ik) 256 253 END DO -
trunk/NEMO/OPA_SRC/DIA/diaptr.F90
r406 r460 14 14 !! : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d 15 15 !!---------------------------------------------------------------------- 16 !! History : 17 !! 9.0 ! 03-09 (C. Talandir, G. Madec) Original code 18 !! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation 19 !!---------------------------------------------------------------------- 16 20 !! * Modules used 17 21 USE oce ! ocean dynamics and active tracers … … 22 26 USE dianam 23 27 USE phycst 28 USE ioipsl ! NetCDF IPSL library 29 USE daymod 24 30 25 31 IMPLICIT NONE … … 89 95 !! ** Action : - p_fval: i-k-mean poleward flux of pva 90 96 !! 91 !! History :92 !! 9.0 ! 03-09 (G. Madec) Original code93 97 !!---------------------------------------------------------------------- 94 98 !! * arguments … … 98 102 !! * local declarations 99 103 INTEGER :: ji, jj, jk ! dummy loop arguments 100 #if ! defined key_agrif101 INTEGER :: ijpj = jpj ! ???102 #else103 104 INTEGER :: ijpj ! ??? 104 #endif105 105 REAL(wp),DIMENSION(jpj) :: & 106 106 p_fval ! function value 107 107 !!-------------------------------------------------------------------- 108 #if defined key_agrif 108 109 109 ijpj = jpj 110 #endif111 112 110 p_fval(:) = 0.e0 113 111 DO jk = 1, jpkm1 … … 137 135 !! ** Action : - p_fval: i-k-mean poleward flux of pva 138 136 !! 139 !! History :140 !! 9.0 ! 03-09 (G. Madec) Original code141 137 !!---------------------------------------------------------------------- 142 138 !! * arguments … … 146 142 !! * local declarations 147 143 INTEGER :: ji,jj ! dummy loop arguments 148 #if ! defined key_agrif149 INTEGER :: ijpj = jpj ! ???150 #else151 144 INTEGER :: ijpj ! ??? 152 #endif153 145 REAL(wp),DIMENSION(jpj) :: & 154 146 p_fval ! function value 155 147 !!-------------------------------------------------------------------- 156 #if defined key_agrif 148 157 149 ijpj = jpj 158 #endif159 160 150 p_fval(:) = 0.e0 161 151 DO jj = 2, jpjm1 … … 182 172 !! ** Action : - p_fval: i-k-mean poleward flux of pva 183 173 !! 184 !! History :185 !! 9.0 ! 03-09 (G. Madec) Original code186 174 !!---------------------------------------------------------------------- 187 175 !! * arguments … … 204 192 DO jj = 2, jpjm1 205 193 DO ji = fs_2, fs_jpim1 206 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) &207 & * tmask_i(ji,jj+1) * tmask_i(ji,jj)194 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 195 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) 208 196 END DO 209 197 END DO 210 198 END DO 211 199 212 IF(lk_mpp) 213 ish(1) = jpj*jpk ; ish2(1)=jpj ; ish2(2)=jpk214 zwork(:)= RESHAPE( p_fval, ish )215 CALL mpp_sum( zwork, jpj*jpk )216 p_fval(:,:)= RESHAPE( zwork,ish2)200 IF(lk_mpp) THEN 201 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 202 zwork(:)= RESHAPE( p_fval, ish ) 203 CALL mpp_sum( zwork, jpj*jpk ) 204 p_fval(:,:)= RESHAPE( zwork, ish2 ) 217 205 END IF 218 206 … … 231 219 !! ** Action : - p_fval: i-k-mean poleward flux of pva 232 220 !! 233 !! History :234 !! 9.0 ! 03-09 (G. Madec) Original code235 !! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation236 221 !!---------------------------------------------------------------------- 237 222 !! * arguments … … 260 245 END DO 261 246 p_fval(:,:) = p_fval(:,:) * 0.5 262 IF(lk_mpp) 263 ish(1) = jpj*jpk ; ish2(1)=jpj ; ish2(2)=jpk264 zwork(:)= RESHAPE( p_fval, ish )265 CALL mpp_sum( zwork, jpj*jpk )247 IF(lk_mpp) THEN 248 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 249 zwork(:)= RESHAPE( p_fval, ish ) 250 CALL mpp_sum( zwork, jpj*jpk ) 266 251 p_fval(:,:)= RESHAPE(zwork,ish2) 267 252 END IF … … 491 476 !! ** Purpose : Initialization, namelist read 492 477 !! 493 !! ** Method : 494 !! 495 !! ** input : Namlist namptr 496 !! 497 !! ** Action : 498 !! 499 !! history : 500 !! 9.0 ! 03-08 (Autor Names) Original code 501 !!---------------------------------------------------------------------- 502 !! * local declarations 478 !!---------------------------------------------------------------------- 503 479 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_1 ! temporary workspace 504 480 … … 529 505 END SUBROUTINE dia_ptr_init 530 506 531 !!---------------------------------------------------------------------532 !! Default option : NetCDF file533 !!---------------------------------------------------------------------534 507 535 508 SUBROUTINE dia_ptr_wri( kt ) … … 541 514 !! ** Method : NetCDF file 542 515 !! 543 !! History : 544 !! 9.0 ! 03-09 (G. Madec) Original code 545 !!---------------------------------------------------------------------- 546 USE ioipsl ! NetCDF IPSL library 547 USE daymod 548 516 !!---------------------------------------------------------------------- 549 517 !! * Arguments 550 518 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 635 603 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, & 636 604 1, 1, 1, jpj, 0, zjulian, zdt, nhoridz, numptr, domain_id=nidom ) 637 ! Vertical grids : gdept , gdepw605 ! Vertical grids : gdept_0, gdepw_0 638 606 CALL histvert( numptr, "deptht", "Vertical T levels", & 639 "m", jpk, gdept , ndepidzt )607 "m", jpk, gdept_0, ndepidzt ) 640 608 CALL histvert( numptr, "depthw", "Vertical W levels", & 641 "m", jpk, gdepw , ndepidzw )609 "m", jpk, gdepw_0, ndepidzw ) 642 610 643 611 ! Zonal mean T and S -
trunk/NEMO/OPA_SRC/DIA/diawri.F90
r389 r460 29 29 USE flx_oce ! sea-ice/ocean forcings variables 30 30 USE diadimg ! dimg direct access file format output 31 USE ioipsl 31 32 32 33 IMPLICIT NONE … … 100 101 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 101 102 !!---------------------------------------------------------------------- 102 !! * Modules used103 USE ioipsl104 105 103 !! * Arguments 106 104 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 186 184 & 0, zjulian, zdt, nh_T, nid_T, domain_id=nidom ) 187 185 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 188 & "m", ipk, gdept , nz_T )186 & "m", ipk, gdept_0, nz_T ) 189 187 ! ! Index of ocean points 190 188 CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T ) ! volume … … 199 197 & 0, zjulian, zdt, nh_U, nid_U, domain_id=nidom ) 200 198 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 201 & "m", ipk, gdept , nz_U )199 & "m", ipk, gdept_0, nz_U ) 202 200 ! ! Index of ocean points 203 201 CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U ) ! volume … … 212 210 & 0, zjulian, zdt, nh_V, nid_V, domain_id=nidom ) 213 211 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 214 & "m", ipk, gdept , nz_V )212 & "m", ipk, gdept_0, nz_V ) 215 213 ! ! Index of ocean points 216 214 CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V ) ! volume … … 225 223 & 0, zjulian, zdt, nh_W, nid_W, domain_id=nidom ) 226 224 CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw 227 & "m", ipk, gdepw , nz_W )225 & "m", ipk, gdepw_0, nz_W ) 228 226 229 227 … … 539 537 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization 540 538 !!---------------------------------------------------------------------- 541 !! * Modules used542 USE ioipsl543 544 539 !! * Arguments 545 540 CHARACTER (len=* ), INTENT( in ) :: & … … 580 575 1, jpi, 1, jpj, 0, zjulian, zdt, nh_i, id_i, domain_id=nidom ) ! Horizontal grid : glamt and gphit 581 576 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 582 "m", jpk, gdept , nz_i)577 "m", jpk, gdept_0, nz_i) 583 578 584 579 ! Declare all the output fields as NetCDF variables
Note: See TracChangeset
for help on using the changeset viewer.
