- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r4147 r6225 7 7 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 8 8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 !!---------------------------------------------------------------------- 10 #if ! defined key_coupled 11 9 !!---------------------------------------------------------------------- 12 10 !!---------------------------------------------------------------------- 13 11 !! Only for ORCA2 ORCA1 and ORCA025 … … 30 28 PUBLIC dia_fwb ! routine called by step.F90 31 29 32 LOGICAL, PUBLIC, PARAMETER :: lk_diafwb = .TRUE. !: fresh water budget flag33 34 30 REAL(wp) :: a_fwf , & 35 31 & a_sshb, a_sshn, a_salb, a_saln … … 37 33 38 34 !! * Substitutions 39 # include "domzgr_substitute.h90"40 35 # include "vectopt_loop_substitute.h90" 41 36 !!---------------------------------------------------------------------- … … 44 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 40 !!---------------------------------------------------------------------- 46 47 41 CONTAINS 48 42 … … 55 49 INTEGER, INTENT( in ) :: kt ! ocean time-step index 56 50 !! 57 INTEGER :: inum ! temporary logical unit 58 INTEGER :: ji, jj, jk, jt ! dummy loop indices 59 INTEGER :: ii0, ii1, ij0, ij1 60 REAL(wp) :: zarea, zvol, zwei 61 REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4) 62 REAL(wp) :: zt, zs, zu 63 REAL(wp) :: zsm0, zfwfnew 51 INTEGER :: inum ! temporary logical unit 52 INTEGER :: ji, jj, jk, jt ! dummy loop indices 53 INTEGER :: ii0, ii1, ij0, ij1 54 INTEGER :: isrow ! index for ORCA1 starting row 55 REAL(wp) :: zarea, zvol, zwei 56 REAL(wp) :: ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4) 57 REAL(wp) :: zt, zs, zu 58 REAL(wp) :: zsm0, zfwfnew 64 59 IF( cp_cfg == "orca" .AND. jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 65 60 !!---------------------------------------------------------------------- … … 77 72 a_salb = 0.e0 ! valeur de sal au debut de la simulation 78 73 ! sshb used because diafwb called after tranxt (i.e. after the swap) 79 a_sshb = SUM( e1 t(:,:) *e2t(:,:) * sshb(:,:) * tmask_i(:,:) )74 a_sshb = SUM( e1e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 80 75 IF( lk_mpp ) CALL mpp_sum( a_sshb ) ! sum over the global domain 81 76 … … 83 78 DO jj = 2, jpjm1 84 79 DO ji = fs_2, fs_jpim1 ! vector opt. 85 zwei = e1 t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)80 zwei = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 86 81 a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 87 82 END DO … … 91 86 ENDIF 92 87 93 a_fwf = SUM( e1 t(:,:) *e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) )88 a_fwf = SUM( e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 94 89 IF( lk_mpp ) CALL mpp_sum( a_fwf ) ! sum over the global domain 95 90 … … 101 96 zfwfnew = 0.e0 102 97 ! Mean sea level at nitend 103 a_sshn = SUM( e1 t(:,:) *e2t(:,:) * sshn(:,:) * tmask_i(:,:) )98 a_sshn = SUM( e1e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 104 99 IF( lk_mpp ) CALL mpp_sum( a_sshn ) ! sum over the global domain 105 zarea = SUM( e1 t(:,:) *e2t(:,:) * tmask_i(:,:) )100 zarea = SUM( e1e2t(:,:) * tmask_i(:,:) ) 106 101 IF( lk_mpp ) CALL mpp_sum( zarea ) ! sum over the global domain 107 102 … … 109 104 DO jj = 2, jpjm1 110 105 DO ji = fs_2, fs_jpim1 ! vector opt. 111 zwei = e1 t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)106 zwei = e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 112 107 a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 113 108 zvol = zvol + zwei … … 119 114 120 115 ! Conversion in m3 121 a_fwf = a_fwf * rdt tra(1)* 1.e-3116 a_fwf = a_fwf * rdt * 1.e-3 122 117 123 118 ! fwf correction to bring back the mean ssh to zero … … 169 164 CASE ( 1 ) ! ORCA_R1 configurations 170 165 ! ! ======================= 171 ii0 = 283 ; ii1 = 283 172 ij0 = 200 ; ij1 = 200 166 ! This dirty section will be suppressed by simplification process: 167 ! all this will come back in input files 168 ! Currently these hard-wired indices relate to configuration with 169 ! extend grid (jpjglo=332) 170 isrow = 332 - jpjglo 171 ! 172 ii0 = 283 ; ii1 = 283 173 ij0 = 241 - isrow ; ij1 = 241 - isrow 173 174 ! ! ======================= 174 175 CASE DEFAULT ! ORCA R05 or R025 … … 183 184 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 184 185 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 185 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)186 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 186 187 187 188 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 216 217 CASE ( 1 ) ! ORCA_R1 configurations 217 218 ! ! ======================= 218 ii0 = 282 ; ii1 = 282 219 ij0 = 200 ; ij1 = 200 219 ! This dirty section will be suppressed by simplification process: 220 ! all this will come back in input files 221 ! Currently these hard-wired indices relate to configuration with 222 ! extend grid (jpjglo=332) 223 isrow = 332 - jpjglo 224 ii0 = 282 ; ii1 = 282 225 ij0 = 240 - isrow ; ij1 = 240 - isrow 220 226 ! ! ======================= 221 227 CASE DEFAULT ! ORCA R05 or R025 … … 230 236 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 231 237 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 232 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)238 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 233 239 234 240 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 263 269 CASE ( 1 ) ! ORCA_R1 configurations 264 270 ! ! ======================= 265 ii0 = 331 ; ii1 = 331 266 ij0 = 176 ; ij1 = 176 271 ! This dirty section will be suppressed by simplification process: 272 ! all this will come back in input files 273 ! Currently these hard-wired indices relate to configuration with 274 ! extend grid (jpjglo=332) 275 isrow = 332 - jpjglo 276 ii0 = 331 ; ii1 = 331 277 ij0 = 215 - isrow ; ij1 = 215 - isrow 267 278 ! ! ======================= 268 279 CASE DEFAULT ! ORCA R05 or R025 … … 277 288 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 278 289 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 279 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)290 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 280 291 281 292 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 310 321 CASE ( 1 ) ! ORCA_R1 configurations 311 322 ! ! ======================= 312 ii0 = 297 ; ii1 = 297 313 ij0 = 230 ; ij1 = 230 323 ! This dirty section will be suppressed by simplification process: 324 ! all this will come back in input files 325 ! Currently these hard-wired indices relate to configuration with 326 ! extend grid (jpjglo=332) 327 isrow = 332 - jpjglo 328 ii0 = 297 ; ii1 = 297 329 ij0 = 269 - isrow ; ij1 = 269 - isrow 314 330 ! ! ======================= 315 331 CASE DEFAULT ! ORCA R05 or R025 … … 324 340 zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 325 341 zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 326 zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)342 zu = un(ji,jj,jk) * e3t_n(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj) 327 343 328 344 IF( un(ji,jj,jk) > 0.e0 ) THEN … … 386 402 WRITE(inum,*) 387 403 WRITE(inum,*) 'Net freshwater budget ' 388 WRITE(inum,9010) ' fwf = ',a_fwf, ' m3 =', a_fwf /(FLOAT(nitend-nit000+1)*rdt tra(1)) * 1.e-6,' Sv'404 WRITE(inum,9010) ' fwf = ',a_fwf, ' m3 =', a_fwf /(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv' 389 405 WRITE(inum,*) 390 406 WRITE(inum,9010) ' zarea =',zarea … … 442 458 ENDIF 443 459 444 IF( nn_timing == 1 ) CALL timing_st art('dia_fwb')460 IF( nn_timing == 1 ) CALL timing_stop('dia_fwb') 445 461 446 462 9005 FORMAT(1X,A,ES24.16) … … 453 469 END SUBROUTINE dia_fwb 454 470 455 #else456 !!----------------------------------------------------------------------457 !! Default option : Dummy Module458 !!----------------------------------------------------------------------459 LOGICAL, PUBLIC, PARAMETER :: lk_diafwb = .FALSE. !: fresh water budget flag460 CONTAINS461 SUBROUTINE dia_fwb( kt ) ! Empty routine462 WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt463 END SUBROUTINE dia_fwb464 #endif465 466 471 !!====================================================================== 467 472 END MODULE diafwb
Note: See TracChangeset
for help on using the changeset viewer.
