Changeset 82
- Timestamp:
- 2004-04-22T15:04:37+02:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DIA/ptr.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/ptr.F90
r24 r82 19 19 USE lib_mpp 20 20 USE in_out_manager 21 USE dianam 22 USE phycst 21 23 22 24 IMPLICIT NONE 23 25 PRIVATE 26 27 INTERFACE prt_vj 28 MODULE PROCEDURE prt_vj_3d, prt_vj_2d 29 END INTERFACE 24 30 25 31 !! * Routine accessibility … … 27 33 PUBLIC dia_ptr ! call by in step module 28 34 PUBLIC prt_vj ! call by tra_ldf & tra_adv routines 35 PUBLIC prt_vjk ! call by tra_ldf & tra_adv routines 29 36 30 37 !! * Share Module variables … … 56 63 CONTAINS 57 64 58 FUNCTION p tr_vj( pva ) RESULT ( p_fval )59 !!---------------------------------------------------------------------- 60 !! *** ROUTINE p tr_vj***65 FUNCTION prt_vj_3d( pva ) RESULT ( p_fval ) 66 !!---------------------------------------------------------------------- 67 !! *** ROUTINE prt_vj_3d *** 61 68 !! 62 69 !! ** Purpose : "zonal" and vertical sum computation of a "meridional" … … 82 89 !!-------------------------------------------------------------------- 83 90 84 p_fval( 1 ) = 0.e0 85 p_fval(jpjm1) = 0.e0 91 p_fval(:) = 0.e0 86 92 DO jk = 1, jpkm1 87 93 DO jj = 2, jpjm1 … … 93 99 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume 94 100 95 END FUNCTION ptr_vj 96 97 98 FUNCTION ptr_vjk( pva ) RESULT ( p_fval ) 99 !!---------------------------------------------------------------------- 100 !! *** ROUTINE ptr_vjk *** 101 END FUNCTION prt_vj_3d 102 103 104 105 FUNCTION prt_vj_2d( pva ) RESULT ( p_fval ) 106 !!---------------------------------------------------------------------- 107 !! *** ROUTINE prt_vj_2d *** 108 !! 109 !! ** Purpose : "zonal" and vertical sum computation of a "meridional" 110 !! flux array 111 !! 112 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 113 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 114 !! 115 !! ** Action : - p_fval: i-k-mean poleward flux of pva 116 !! 117 !! History : 118 !! 9.0 ! 03-09 (G. Madec) Original code 119 !!---------------------------------------------------------------------- 120 !! * arguments 121 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: & 122 pva ! mask flux array at V-point 123 124 !! * local declarations 125 INTEGER :: ji, jj ! dummy loop arguments 126 INTEGER :: ijpj = jpj ! ??? 127 REAL(wp),DIMENSION(jpj) :: & 128 p_fval ! function value 129 !!-------------------------------------------------------------------- 130 131 p_fval(:) = 0.e0 132 DO jj = 2, jpjm1 133 DO ji = fs_2, fs_jpim1 ! Vector opt. 134 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj+1) * tmask_i(ji,jj) 135 END DO 136 END DO 137 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume 138 139 END FUNCTION prt_vj_2d 140 141 142 143 FUNCTION prt_vjk( pva ) RESULT ( p_fval ) 144 !!---------------------------------------------------------------------- 145 !! *** ROUTINE prt_vjk *** 101 146 !! 102 147 !! ** Purpose : "zonal" sum computation of a "meridional" flux array … … 120 165 !!-------------------------------------------------------------------- 121 166 122 p_fval( 1 , : ) = 0.e0 123 p_fval(jpjm1, : ) = 0.e0 124 p_fval( : ,jpk) = 0.e0 167 p_fval(:,:) = 0.e0 125 168 DO jk = 1, jpkm1 126 169 DO jj = 2, jpjm1 … … 132 175 IF( lk_mpp) CALL mpp_sum( p_fval, jpj*jpk ) !!bug I presume 133 176 134 END FUNCTION p tr_vjk135 136 FUNCTION p tr_vtjk( pva ) RESULT ( p_fval )137 !!---------------------------------------------------------------------- 138 !! *** ROUTINE p tr_vtjk ***177 END FUNCTION prt_vjk 178 179 FUNCTION prt_vtjk( pva ) RESULT ( p_fval ) 180 !!---------------------------------------------------------------------- 181 !! *** ROUTINE prt_vtjk *** 139 182 !! 140 183 !! ** Purpose : "zonal" mean computation of a tracer field … … 158 201 p_fval ! return function value 159 202 !!-------------------------------------------------------------------- 160 p_fval( 1 , : ) = 0.e0 161 p_fval(jpjm1, : ) = 0.e0 162 p_fval( : ,jpk) = 0.e0 203 204 p_fval(:,:) = 0.e0 163 205 DO jk = 1, jpkm1 164 206 DO jj = 2, jpjm1 165 207 DO ji = fs_2, fs_jpim1 ! Vector opt. 166 p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj ,jk) )&208 p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj+1,jk) ) & 167 209 & * e1v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) & 168 210 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) … … 170 212 END DO 171 213 END DO 172 p_fval(:,:) = p_ val(:,:) * 0.5214 p_fval(:,:) = p_fval(:,:) * 0.5 173 215 IF( lk_mpp ) CALL mpp_sum( p_fval, jpj*jpk ) !!bug I presume 174 216 175 END FUNCTION p tr_vtjk217 END FUNCTION prt_vtjk 176 218 177 219 … … 184 226 185 227 !! * Local variables 228 INTEGER :: jk ! dummy loop 186 229 REAL(wp) :: & 187 zsverdrup = 1.e-6 188 REAL(wp), DIMENSION(jpi,jpj,jpk) :: &189 z vfl ! mask flux array at V-point230 zsverdrup = 1.e-6, & ! conversion from m3/s to Sverdrup 231 zpwatt = 1.e-15, & ! conversion from W to PW 232 zggram = 1.e-6 ! conversion from g to Pg 190 233 !!---------------------------------------------------------------------- 191 234 … … 208 251 ! poleward transport: overturning component 209 252 pht_ove(:) = SUM( v_msf(:,:) * tn_jk(:,:), 2 ) ! SUM over jk 253 pst_ove(:) = SUM( v_msf(:,:) * sn_jk(:,:), 2 ) ! SUM over jk 254 255 ! conversion in PW and G g 256 zpwatt = zpwatt * rau0 * rcp 257 pht_adv(:) = pht_adv(:) * zpwatt 258 pht_ove(:) = pht_ove(:) * zpwatt 259 pht_ldf(:) = pht_ldf(:) * zpwatt 260 pht_eiv(:) = pht_eiv(:) * zpwatt 261 pst_adv(:) = pst_adv(:) * zggram 262 pst_ove(:) = pst_ove(:) * zggram 263 pst_ldf(:) = pst_ldf(:) * zggram 264 pst_eiv(:) = pst_eiv(:) * zggram 210 265 211 266 ! "Meridional" Stream-Function … … 259 314 ! inverse of the ocean "zonal" v-point section 260 315 z_1(:,:,:) = 1.e0 261 surf_jk_r(:,:) = prt_vtjk( z 1(:,:,:) )316 surf_jk_r(:,:) = prt_vtjk( z_1(:,:,:) ) 262 317 WHERE( surf_jk_r(:,:) /= 0.e0 ) surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:) 263 318 … … 282 337 !! * Arguments 283 338 INTEGER, INTENT(in) :: kt ! ocean time-step index 339 REAL(wp), DIMENSION(jpjglo) :: zphi, zfoo 284 340 !!---------------------------------------------------------------------- 285 341 … … 291 347 IF( cp_cfg == "orca" ) THEN ! ORCA configurations 292 348 ! ! ======================= 293 294 iline = 100 / jp_cfg ! i-line that passes near the North Pole 349 350 IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole 351 IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole 352 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 353 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 354 295 355 zphi(:) = 0.e0 296 356 DO ji = mi0(iline), mi1(iline) 297 357 zphi(:) = gphiv(ji,:) ! if iline is in the local domain 298 358 END DO 299 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) ! provide the correct zphi to all local domains 359 ! provide the correct zphi to all local domains 360 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) 361 ! introduce arbitray northernmost grid point to avoid netcdf error 362 zphi(jpjglo) = 2*zphi(jpjglo-1)-zphi(jpjglo-2) 300 363 301 364 ! ! ======================= … … 323 386 ENDIF 324 387 325 IF( kt == = nitend ) CLOSE( numptr )388 IF( kt == nitend ) CLOSE( numptr ) 326 389 327 390 END SUBROUTINE dia_ptr_wri … … 344 407 !!---------------------------------------------------------------------- 345 408 USE ioipsl ! NetCDF IPSL library 409 USE daymod 346 410 347 411 !! * Arguments … … 353 417 354 418 !! * Local variables 355 CHARACTER (len=15) :: clexp356 419 CHARACTER (len=40) :: & 357 clhstnam, clop, clmax ! temporary names 420 clhstnam, clop ! temporary names 421 INTEGER :: iline, it, ji ! 358 422 REAL(wp) :: & 359 zsto, zout, zdt, 423 zsto, zout, zdt, zmax, & ! temporary scalars 360 424 zjulian 425 REAL(wp), DIMENSION(jpjglo) :: zphi, zfoo 361 426 !!---------------------------------------------------------------------- 362 427 … … 393 458 ! ! ======================= 394 459 395 iline = 100 / jp_cfg ! i-line that passes near the North Pole 396 zphi(:) = 0.e0 460 IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole 461 IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole 462 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 463 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 464 zphi(:) = 0.e0 397 465 DO ji = mi0(iline), mi1(iline) 398 466 zphi(:) = gphiv(ji,:) ! if iline is in the local domain 399 467 END DO 400 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) ! provide the correct zphi to all local domains 468 ! provide the correct zphi to all local domains 469 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) 401 470 402 471 ! ! ======================= … … 413 482 clop = "ave(x)" 414 483 zout = nf_ptr * zdt 415 zfoo = 0.e0484 zfoo(:) = 0.e0 416 485 417 486 ! Compute julian date from starting date of the run … … 463 532 #if defined key_diaeiv 464 533 ! Eddy induced velocity 465 CALL histdef( numptr, "zomsf glo", "Meridional Stream-Function: global", &534 CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", & 466 535 "Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 467 536 CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", & … … 479 548 ! define time axis 480 549 it= kt - nit000 + 1 550 ndex(1) = 1 481 551 CALL histwrite( numptr, "zotemglo", it, tn_jk , jpj*jpk, ndex ) 482 552 CALL histwrite( numptr, "zosalglo", it, sn_jk , jpj*jpk, ndex ) … … 497 567 498 568 ! Close the file 499 IF( kt == =nitend ) CALL histclo( numptr ) ! Netcdf write569 IF( kt == nitend ) CALL histclo( numptr ) ! Netcdf write 500 570 501 571 END SUBROUTINE dia_ptr_wri … … 508 578 !!---------------------------------------------------------------------- 509 579 LOGICAL, PUBLIC, PARAMETER :: lk_diaptr = .FALSE. ! poleward transport flag 580 INTEGER, PUBLIC :: & !!: ** ptr namelist (namptr) ** 581 nf_ptr = 15 !: frequency of ptr computation 510 582 CONTAINS 511 583 SUBROUTINE dia_ptr( kt ) ! Empty routine
Note: See TracChangeset
for help on using the changeset viewer.
