Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • nemo/nemo
  • sparonuz/nemo
  • hatfield/nemo
  • extdevs/nemo
4 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 145 additions and 141 deletions
src/OCE/ZDF/zdfosm.F90
View file @ c72255b2
...@@ -486,8 +486,8 @@ CONTAINS ...@@ -486,8 +486,8 @@ CONTAINS
& grav * zbeta * swsav(ji,jj) ! OBSBL & grav * zbeta * swsav(ji,jj) ! OBSBL
END_2D END_2D
DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
suw0(ji,jj) = -0.5_wp * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) ! Surface upward velocity fluxes suw0(ji,jj) = - utau(ji,jj) * r1_rho0 * tmask(ji,jj,1) ! Surface upward velocity fluxes
zvw0 = -0.5_wp * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) zvw0 = - vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1)
sustar(ji,jj) = MAX( SQRT( SQRT( suw0(ji,jj) * suw0(ji,jj) + zvw0 * zvw0 ) ), & ! Friction velocity (sustar), at sustar(ji,jj) = MAX( SQRT( SQRT( suw0(ji,jj) * suw0(ji,jj) + zvw0 * zvw0 ) ), & ! Friction velocity (sustar), at
& 1e-8_wp ) ! T-point : LMD94 eq. 2 & 1e-8_wp ) ! T-point : LMD94 eq. 2
scos_wind(ji,jj) = -1.0_wp * suw0(ji,jj) / ( sustar(ji,jj) * sustar(ji,jj) ) scos_wind(ji,jj) = -1.0_wp * suw0(ji,jj) / ( sustar(ji,jj) * sustar(ji,jj) )
......
src/OCE/ZDF/zdftke.F90
View file @ c72255b2
...@@ -210,7 +210,7 @@ CONTAINS ...@@ -210,7 +210,7 @@ CONTAINS
REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient
REAL(wp) :: zbbrau, zbbirau, zri ! local scalars REAL(wp) :: zbbrau, zbbirau, zri ! local scalars
REAL(wp) :: zfact1, zfact2, zfact3 ! - - REAL(wp) :: zfact1, zfact2, zfact3 ! - -
REAL(wp) :: ztx2 , zty2 , zcof ! - - REAL(wp) :: zcof ! - -
REAL(wp) :: ztau , zdif ! - - REAL(wp) :: ztau , zdif ! - -
REAL(wp) :: zus , zwlc , zind ! - - REAL(wp) :: zus , zwlc , zind ! - -
REAL(wp) :: zzd_up, zzd_lw ! - - REAL(wp) :: zzd_up, zzd_lw ! - -
...@@ -302,8 +302,8 @@ CONTAINS ...@@ -302,8 +302,8 @@ CONTAINS
! Projection of Stokes drift in the wind stress direction ! Projection of Stokes drift in the wind stress direction
! !
DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
ztaui = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) ztaui = utau(ji,jj)
ztauj = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) ztauj = vtau(ji,jj)
z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1) z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1)
zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2
END_2D END_2D
...@@ -483,9 +483,7 @@ CONTAINS ...@@ -483,9 +483,7 @@ CONTAINS
END_2D END_2D
ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability)
DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
ztx2 = utau(ji-1,jj ) + utau(ji,jj) ztau = SQRT( utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj) ) * tmask(ji,jj,1) ! module of the mean stress
zty2 = vtau(ji ,jj-1) + vtau(ji,jj)
ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1) ! module of the mean stress
zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean
zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications...
en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) &
......
src/OCE/lib_fortran.F90
View file @ c72255b2
...@@ -191,11 +191,11 @@ CONTAINS ...@@ -191,11 +191,11 @@ CONTAINS
! work over the whole domain (guarantees all internal cells are set when nn_hls=2) ! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1) IF( MOD(mig(ji,nn_hls), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
& MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box & MOD(mjg(jj,nn_hls), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box ji2 = MIN(mig(ji,nn_hls)+2, jpiglo) - nimpp + 1 ! right position of the box
jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box jj2 = MIN(mjg(jj,nn_hls)+2, jpjglo) - njmpp + 1 ! upper position of the box
IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2)) p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
ENDIF ENDIF
ENDIF ENDIF
...@@ -203,23 +203,23 @@ CONTAINS ...@@ -203,23 +203,23 @@ CONTAINS
CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
! no need for 2nd exchange when nn_hls > 1 ! no need for 2nd exchange when nn_hls > 1
IF( nn_hls == 1 ) THEN IF( nn_hls == 1 ) THEN
IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally IF( MOD(mig( 1,nn_hls), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2 p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
IF( MOD(mig( 1), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh IF( MOD(mig( 1,nn_hls), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on w-neighbourh
p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2 p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
ENDIF ENDIF
IF( mpiRnei(nn_hls,jpea) > -1 ) THEN IF( mpiRnei(nn_hls,jpea) > -1 ) THEN
IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:) IF( MOD(mig(jpi-2,nn_hls), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:)
IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:) IF( MOD(mig(jpi-2,nn_hls), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:)
ENDIF ENDIF
IF( mpiRnei(nn_hls,jpso) > -1 ) THEN IF( mpiRnei(nn_hls,jpso) > -1 ) THEN
IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2) IF( MOD(mjg( 1,nn_hls), 3) == 1 ) p2d(:, 1) = p2d(:, 2)
IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1) IF( MOD(mjg( 1,nn_hls), 3) == 2 ) p2d(:, 2) = p2d(:, 1)
ENDIF ENDIF
IF( mpiRnei(nn_hls,jpno) > -1 ) THEN IF( mpiRnei(nn_hls,jpno) > -1 ) THEN
IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1) IF( MOD(mjg(jpj-2,nn_hls), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1)
IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj) IF( MOD(mjg(jpj-2,nn_hls), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj)
ENDIF ENDIF
CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
ENDIF ENDIF
...@@ -247,11 +247,11 @@ CONTAINS ...@@ -247,11 +247,11 @@ CONTAINS
! work over the whole domain (guarantees all internal cells are set when nn_hls=2) ! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
! !
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1) IF( MOD(mig(ji,nn_hls), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
& MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box & MOD(mjg(jj,nn_hls), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box ji2 = MIN(mig(ji,nn_hls)+2, jpiglo) - nimpp + 1 ! right position of the box
jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box jj2 = MIN(mjg(jj,nn_hls)+2, jpjglo) - njmpp + 1 ! upper position of the box
IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn)) p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
ENDIF ENDIF
ENDIF ENDIF
...@@ -260,23 +260,23 @@ CONTAINS ...@@ -260,23 +260,23 @@ CONTAINS
CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
! no need for 2nd exchange when nn_hls > 1 ! no need for 2nd exchange when nn_hls > 1
IF( nn_hls == 1 ) THEN IF( nn_hls == 1 ) THEN
IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally IF( MOD(mig( 1,nn_hls), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2 p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
IF( MOD(mig( 1), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh IF( MOD(mig( 1,nn_hls), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on w-neighbourh
p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2 p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
ENDIF ENDIF
IF( mpiRnei(nn_hls,jpea) > -1 ) THEN IF( mpiRnei(nn_hls,jpea) > -1 ) THEN
IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:) IF( MOD(mig(jpi-2,nn_hls), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:)
IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:) IF( MOD(mig(jpi-2,nn_hls), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:)
ENDIF ENDIF
IF( mpiRnei(nn_hls,jpso) > -1 ) THEN IF( mpiRnei(nn_hls,jpso) > -1 ) THEN
IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:) IF( MOD(mjg( 1,nn_hls), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:)
IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:) IF( MOD(mjg( 1,nn_hls), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:)
ENDIF ENDIF
IF( mpiRnei(nn_hls,jpno) > -1 ) THEN IF( mpiRnei(nn_hls,jpno) > -1 ) THEN
IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:) IF( MOD(mjg(jpj-2,nn_hls), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:)
IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:) IF( MOD(mjg(jpj-2,nn_hls), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)
ENDIF ENDIF
CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
ENDIF ENDIF
......
src/OCE/lib_fortran_generic.h90
View file @ c72255b2
...@@ -51,8 +51,8 @@ ...@@ -51,8 +51,8 @@
iis = Nis0 ; iie = Nie0 iis = Nis0 ; iie = Nie0
ijs = Njs0 ; ije = Nje0 ijs = Njs0 ; ije = Nje0
ELSE ELSE
iis = 1 ; iie = jpi iis = 1 ; iie = ipi
ijs = 1 ; ije = jpj ijs = 1 ; ije = ipj
ENDIF ENDIF
! !
ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated ctmp = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
......
src/OCE/stp2d.F90
View file @ c72255b2
...@@ -151,14 +151,14 @@ CONTAINS ...@@ -151,14 +151,14 @@ CONTAINS
! !* wind forcing *! ! !* wind forcing *!
IF( ln_bt_fw ) THEN IF( ln_bt_fw ) THEN
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kbb) Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + r1_rho0 * utauU(ji,jj) * r1_hu(ji,jj,Kbb)
Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + r1_rho0 * vtau(ji,jj) * r1_hv(ji,jj,Kbb) Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + r1_rho0 * vtauV(ji,jj) * r1_hv(ji,jj,Kbb)
END_2D END_2D
ELSE ELSE
zztmp = r1_rho0 * r1_2 zztmp = r1_rho0 * r1_2
DO_2D( 0, 0, 0, 0 ) DO_2D( 0, 0, 0, 0 )
Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kbb) Ue_rhs(ji,jj) = Ue_rhs(ji,jj) + zztmp * ( utau_b(ji,jj) + utauU(ji,jj) ) * r1_hu(ji,jj,Kbb)
Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kbb) Ve_rhs(ji,jj) = Ve_rhs(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtauV(ji,jj) ) * r1_hv(ji,jj,Kbb)
END_2D END_2D
ENDIF ENDIF
! !
......
src/OCE/stpctl.F90
View file @ c72255b2
...@@ -231,7 +231,7 @@ CONTAINS ...@@ -231,7 +231,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) ) iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF ENDIF
......
src/SAS/diawri.F90
View file @ c72255b2
...@@ -317,22 +317,22 @@ CONTAINS ...@@ -317,22 +317,22 @@ CONTAINS
! !
ENDIF ENDIF
! !
CALL histdef( nid_T, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
& jpi, jpj, nh_T, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histdef( nid_T, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
& jpi, jpj, nh_T, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histend( nid_T, snc4chunks=snc4set ) CALL histend( nid_T, snc4chunks=snc4set )
! !!! nid_U : 3D ! !!! nid_U : 3D
CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s" , & ! ssu CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s" , & ! ssu
& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) & jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histend( nid_U, snc4chunks=snc4set ) CALL histend( nid_U, snc4chunks=snc4set )
! !!! nid_V : 3D ! !!! nid_V : 3D
CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s", & ! ssv_m CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s", & ! ssv_m
& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) & jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
CALL histend( nid_V, snc4chunks=snc4set ) CALL histend( nid_V, snc4chunks=snc4set )
...@@ -366,6 +366,8 @@ CONTAINS ...@@ -366,6 +366,8 @@ CONTAINS
CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction
CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed
CALL histwrite( nid_T, "sozotaux", it, utau , ndim_hT, ndex_hT ) ! i-wind stress
CALL histwrite( nid_T, "sometauy", it, vtau , ndim_hT, ndex_hT ) ! j-wind stress
! !
IF( ln_abl ) THEN IF( ln_abl ) THEN
ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
...@@ -393,11 +395,9 @@ CONTAINS ...@@ -393,11 +395,9 @@ CONTAINS
! Write fields on U grid ! Write fields on U grid
CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed
CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
! Write fields on V grid ! Write fields on V grid
CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed
CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
! 3. Close all files ! 3. Close all files
! --------------------------------------- ! ---------------------------------------
......
src/SAS/stpctl.F90
View file @ c72255b2
...@@ -191,7 +191,7 @@ CONTAINS ...@@ -191,7 +191,7 @@ CONTAINS
iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk ) iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk )
iloc(1:2,3) = MINLOC( tm_i(:,:) - rt0, mask = llmsk ) iloc(1:2,3) = MINLOC( tm_i(:,:) - rt0, mask = llmsk )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF ENDIF
......
src/SWE/stpctl.F90
View file @ c72255b2
...@@ -185,7 +185,7 @@ CONTAINS ...@@ -185,7 +185,7 @@ CONTAINS
llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) ) iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF ENDIF
......
src/SWE/stpmlf.F90
View file @ c72255b2
...@@ -114,9 +114,9 @@ CONTAINS ...@@ -114,9 +114,9 @@ CONTAINS
zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj)
zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj)
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utauU(ji,jj) ) / e3u(ji,jj,jk,Nnn) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / e3v(ji,jj,jk,Nnn) & zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) / e3v(ji,jj,jk,Nnn) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
! ! ==> RHS ! ! ==> RHS
uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u
......
src/SWE/stprk3.F90
View file @ c72255b2
...@@ -135,9 +135,9 @@ CONTAINS ...@@ -135,9 +135,9 @@ CONTAINS
zrhs_v = - grav * ( ssh(ji,jj+1,Nbb) - ssh(ji,jj,Nbb) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nbb) - ssh(ji,jj,Nbb) ) * r1_e2v(ji,jj)
#if defined key_RK3all #if defined key_RK3all
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + r1_rho0 * ( z5_6*utau_b(ji,jj) + (1._wp - z5_6)*utau(ji,jj) ) / e3u(ji,jj,jk,Nbb) & zrhs_u = zrhs_u + r1_rho0 * ( z5_6*utau_b(ji,jj) + (1._wp - z5_6)*utauU(ji,jj) ) / e3u(ji,jj,jk,Nbb) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + r1_rho0 * ( z5_6*vtau_b(ji,jj) + (1._wp - z5_6)*vtau(ji,jj) ) / e3v(ji,jj,jk,Nbb) & zrhs_v = zrhs_v + r1_rho0 * ( z5_6*vtau_b(ji,jj) + (1._wp - z5_6)*vtauV(ji,jj) ) / e3v(ji,jj,jk,Nbb) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
#endif #endif
! ! ==> RHS ! ! ==> RHS
...@@ -201,9 +201,9 @@ CONTAINS ...@@ -201,9 +201,9 @@ CONTAINS
zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj)
#if defined key_RK3all #if defined key_RK3all
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + r1_rho0 * ( z3_4*utau_b(ji,jj) + (1._wp - z3_4)*utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & zrhs_u = zrhs_u + r1_rho0 * ( z3_4*utau_b(ji,jj) + (1._wp - z3_4)*utauU(ji,jj) ) / e3u(ji,jj,jk,Nnn) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + r1_rho0 * ( z3_4*vtau_b(ji,jj) + (1._wp - z3_4)*vtau(ji,jj) ) / e3v(ji,jj,jk,Nnn) & zrhs_v = zrhs_v + r1_rho0 * ( z3_4*vtau_b(ji,jj) + (1._wp - z3_4)*vtauV(ji,jj) ) / e3v(ji,jj,jk,Nnn) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
#endif #endif
! ! ==> RHS ! ! ==> RHS
...@@ -265,9 +265,9 @@ CONTAINS ...@@ -265,9 +265,9 @@ CONTAINS
zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) zrhs_u = - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj)
zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) zrhs_v = - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj)
! ! wind stress and layer friction ! ! wind stress and layer friction
zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utau(ji,jj) ) / e3u(ji,jj,jk,Nnn) & zrhs_u = zrhs_u + z1_2rho0 * ( utau_b(ji,jj) + utauU(ji,jj) ) / e3u(ji,jj,jk,Nnn) &
& - rn_rfr * uu(ji,jj,jk,Nbb) & - rn_rfr * uu(ji,jj,jk,Nbb)
zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / e3v(ji,jj,jk,Nnn) & zrhs_v = zrhs_v + z1_2rho0 * ( vtau_b(ji,jj) + vtauV(ji,jj) ) / e3v(ji,jj,jk,Nnn) &
& - rn_rfr * vv(ji,jj,jk,Nbb) & - rn_rfr * vv(ji,jj,jk,Nbb)
! ! ==> RHS ! ! ==> RHS
uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u uu(ji,jj,jk,Nrhs) = uu(ji,jj,jk,Nrhs) + zrhs_u
......
src/TOP/AGE/trcsms_age.F90
View file @ c72255b2
...@@ -46,7 +46,7 @@ CONTAINS ...@@ -46,7 +46,7 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time-step index INTEGER, INTENT(in) :: kt ! ocean time-step index
INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level
INTEGER :: jn, jk ! dummy loop index INTEGER :: jk ! dummy loop index
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
! !
IF( ln_timing ) CALL timing_start('trc_sms_age') IF( ln_timing ) CALL timing_start('trc_sms_age')
...@@ -74,7 +74,7 @@ CONTAINS ...@@ -74,7 +74,7 @@ CONTAINS
tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear tr(:,:,jk,jp_age,Krhs) = tmask(:,:,jk) * rryear
END DO END DO
! !
IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends IF( l_trdtrc ) CALL trd_trc( tr(:,:,:,jp_age,Krhs), jp_age, jptra_sms, kt, Kmm ) ! save trends
! !
IF( ln_timing ) CALL timing_stop('trc_sms_age') IF( ln_timing ) CALL timing_stop('trc_sms_age')
! !
......
src/TOP/AGE/trcwri_age.F90
View file @ c72255b2
...@@ -28,7 +28,6 @@ CONTAINS ...@@ -28,7 +28,6 @@ CONTAINS
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
INTEGER, INTENT(in) :: Kmm ! time level indices INTEGER, INTENT(in) :: Kmm ! time level indices
CHARACTER (len=20) :: cltra CHARACTER (len=20) :: cltra
INTEGER :: jn
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! write the tracer concentrations in the file ! write the tracer concentrations in the file
......
src/TOP/C14/sms_c14.F90
View file @ c72255b2
...@@ -51,6 +51,8 @@ MODULE sms_c14 ...@@ -51,6 +51,8 @@ MODULE sms_c14
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: spco2 ! Atmospheric CO2 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: spco2 ! Atmospheric CO2
REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: tyrco2 ! Time (yr) atmospheric CO2 data REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: tyrco2 ! Time (yr) atmospheric CO2 data
!! * Substitutions
# include "do_loop_substitute.h90"
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018) !! NEMO/TOP 4.0 , NEMO Consortium (2018)
!! $Id: sms_c14.F90 10071 2018-08-28 14:49:04Z nicolasmartin $ !! $Id: sms_c14.F90 10071 2018-08-28 14:49:04Z nicolasmartin $
...@@ -64,9 +66,9 @@ CONTAINS ...@@ -64,9 +66,9 @@ CONTAINS
!! *** ROUTINE trc_sms_c14_alloc *** !! *** ROUTINE trc_sms_c14_alloc ***
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
sms_c14_alloc = 0 sms_c14_alloc = 0
ALLOCATE( exch_c14(jpi,jpj) , exch_co2(jpi,jpj) , & ALLOCATE( exch_c14(A2D(0)) , exch_co2(A2D(0)) , &
& qtr_c14(jpi,jpj) , qint_c14(jpi,jpj) , & & qtr_c14(A2D(0)) , qint_c14(A2D(0)) , &
& c14sbc(jpi,jpj) , STAT = sms_c14_alloc ) & c14sbc(A2D(0)) , STAT = sms_c14_alloc )
! !
! !
END FUNCTION sms_c14_alloc END FUNCTION sms_c14_alloc
......
src/TOP/C14/trcatm_c14.F90
View file @ c72255b2
...@@ -59,6 +59,13 @@ CONTAINS ...@@ -59,6 +59,13 @@ CONTAINS
! !
tyrc14_now = 0._wp ! initialize tyrc14_now = 0._wp ! initialize
! !
IF( kc14typ == 0) THEN
co2sbc=pco2at
DO_2D( 0, 0, 0, 0 )
c14sbc(ji,jj) = rc14at
END_2D
ENDIF
!
IF(kc14typ >= 1) THEN ! Transient atmospheric forcing: CO2 IF(kc14typ >= 1) THEN ! Transient atmospheric forcing: CO2
! !
clfile = TRIM( cfileco2 ) clfile = TRIM( cfileco2 )
...@@ -116,10 +123,10 @@ CONTAINS ...@@ -116,10 +123,10 @@ CONTAINS
! Linear interpolation of the C-14 source fonction ! Linear interpolation of the C-14 source fonction
! in linear latitude bands (20N,40N) and (20S,40S) ! in linear latitude bands (20N,40N) and (20S,40S)
!------------------------------------------------------ !------------------------------------------------------
ALLOCATE( fareaz (jpi,jpj ,nc14zon) , STAT=ierr3 ) ALLOCATE( fareaz(A2D(0) ,nc14zon) , STAT=ierr3 )
IF( ierr3 /= 0 ) CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' ) IF( ierr3 /= 0 ) CALL ctl_stop( 'STOP', 'trc_atm_c14_ini: unable to allocate fareaz' )
! !
DO_2D( 1, 1, 1, 1 ) ! from C14b package DO_2D( 0, 0, 0, 0 ) ! from C14b package
IF( gphit(ji,jj) >= yn40 ) THEN IF( gphit(ji,jj) >= yn40 ) THEN
fareaz(ji,jj,1) = 0. fareaz(ji,jj,1) = 0.
fareaz(ji,jj,2) = 0. fareaz(ji,jj,2) = 0.
...@@ -205,9 +212,9 @@ CONTAINS ...@@ -205,9 +212,9 @@ CONTAINS
!! ** Action : atmospheric values interpolated at time-step kt !! ** Action : atmospheric values interpolated at time-step kt
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kt ! ocean time-step INTEGER , INTENT(in ) :: kt ! ocean time-step
REAL(wp), DIMENSION(:,:), INTENT( out) :: c14sbc ! atm c14 ratio REAL(wp), DIMENSION(A2D(0)), INTENT( out) :: c14sbc ! atm c14 ratio
REAL(wp), INTENT( out) :: co2sbc ! atm co2 p REAL(wp), INTENT( out) :: co2sbc ! atm co2 p
INTEGER :: jz ! dummy loop indice INTEGER :: ji, jj, jz ! dummy loop indice
REAL(wp) :: zdint,zint ! work REAL(wp) :: zdint,zint ! work
REAL(wp), DIMENSION(nc14zon) :: zonbc14 ! work REAL(wp), DIMENSION(nc14zon) :: zonbc14 ! work
! !
...@@ -215,10 +222,6 @@ CONTAINS ...@@ -215,10 +222,6 @@ CONTAINS
! !
IF( ln_timing ) CALL timing_start('trc_atm_c14') IF( ln_timing ) CALL timing_start('trc_atm_c14')
! !
IF( kc14typ == 0) THEN
co2sbc=pco2at
c14sbc(:,:)=rc14at
ENDIF
! !
IF(kc14typ >= 1) THEN ! Transient C14 & CO2 IF(kc14typ >= 1) THEN ! Transient C14 & CO2
! !
......
src/TOP/C14/trcsms_c14.F90
View file @ c72255b2
...@@ -80,7 +80,7 @@ CONTAINS ...@@ -80,7 +80,7 @@ CONTAINS
! CO2 solubility (Weiss, 1974; Wanninkhof, 2014) ! CO2 solubility (Weiss, 1974; Wanninkhof, 2014)
! ------------------------------------------------------------------- ! -------------------------------------------------------------------
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( tmask(ji,jj,1) > 0. ) THEN IF( tmask(ji,jj,1) > 0. ) THEN
! !
zt = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) ) zt = MIN( 40. , ts(ji,jj,1,jp_tem,Kmm) )
...@@ -121,21 +121,21 @@ CONTAINS ...@@ -121,21 +121,21 @@ CONTAINS
! !
! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s ! Flux of C-14 from air-to-sea; units: (C14/C ratio) x m/s
! already masked ! already masked
qtr_c14(:,:) = exch_c14(:,:) * ( c14sbc(:,:) - tr(:,:,1,jp_c14,Kbb) ) DO_2D( 0, 0, 0, 0 )
qtr_c14(ji,jj) = exch_c14(ji,jj) * ( c14sbc(ji,jj) - tr(ji,jj,1,jp_c14,Kbb) )
END_2D
! cumulation of air-to-sea flux at each time step ! cumulation of air-to-sea flux at each time step
qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt qint_c14(:,:) = qint_c14(:,:) + qtr_c14(:,:) * rn_Dt
! !
! Add the surface flux to the trend of jp_c14 ! Add the surface flux to the trend of jp_c14
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm) tr(ji,jj,1,jp_c14,Krhs) = tr(ji,jj,1,jp_c14,Krhs) + qtr_c14(ji,jj) / e3t(ji,jj,1,Kmm)
END_2D END_2D
! !
! Computation of decay effects on jp_c14 ! Computation of decay effects on jp_c14
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
!
tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk) tr(ji,jj,jk,jp_c14,Krhs) = tr(ji,jj,jk,jp_c14,Krhs) - rlam14 * tr(ji,jj,jk,jp_c14,Kbb) * tmask(ji,jj,jk)
!
END_3D END_3D
! !
IF( lrst_trc ) THEN IF( lrst_trc ) THEN
......
src/TOP/C14/trcwri_c14.F90
View file @ c72255b2
...@@ -38,8 +38,8 @@ CONTAINS ...@@ -38,8 +38,8 @@ CONTAINS
CHARACTER (len=20) :: cltra ! short title for tracer CHARACTER (len=20) :: cltra ! short title for tracer
INTEGER :: ji,jj,jk,jn ! dummy loop indexes INTEGER :: ji,jj,jk,jn ! dummy loop indexes
REAL(wp) :: zage,zarea,ztemp ! temporary REAL(wp) :: zage,zarea,ztemp ! temporary
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zres, z2d ! temporary storage 2D REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d ! temporary storage 2D
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d , zz3d ! temporary storage 3D REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d ! temporary storage 3D
!!--------------------------------------------------------------------- !!---------------------------------------------------------------------
! write the tracer concentrations in the file ! write the tracer concentrations in the file
...@@ -49,41 +49,35 @@ CONTAINS ...@@ -49,41 +49,35 @@ CONTAINS
! compute and write the tracer diagnostic in the file ! compute and write the tracer diagnostic in the file
! --------------------------------------- ! ---------------------------------------
IF( iom_use("qtr_c14") ) CALL iom_put( "qtr_c14" , rsiyea * qtr_c14(:,:) ) ! Radiocarbon surf flux [./m2/yr]
CALL iom_put( "qint_c14", qint_c14(:,:) ) ! cumulative flux [./m2]
IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge") ) THEN IF( iom_use("DeltaC14") .OR. iom_use("C14Age") .OR. iom_use("RAge") ) THEN
! !
ALLOCATE( z2d(jpi,jpj), zres(jpi,jpj) ) ALLOCATE( z2d(A2D(0)), z3d(A2D(0),jpk) )
ALLOCATE( z3d(jpi,jpj,jpk), zz3d(jpi,jpj,jpk) )
! !
zage = -1._wp / rlam14 / rsiyea ! factor for radioages in year zage = -1._wp / rlam14 / rsiyea ! factor for radioages in year
z3d(:,:,:) = 1._wp z3d(:,:,:) = 1._wp
zz3d(:,:,:) = 0._wp
! !
DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) DO_3D( 0, 0, 0, 0, 1, jpkm1 )
IF( tmask(ji,jj,jk) > 0._wp) THEN IF( tmask(ji,jj,jk) > 0._wp) THEN
z3d (ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm) z3d(ji,jj,jk) = tr(ji,jj,jk,jp_c14,Kmm)
zz3d(ji,jj,jk) = LOG( z3d(ji,jj,jk) )
ENDIF ENDIF
END_3D END_3D
zres(:,:) = z3d(:,:,1) CALL iom_put( "C14Age", zage * LOG( z3d(:,:,:) ) ) ! Radiocarbon age [yr]
! Reservoir age [yr] ! Reservoir age [yr]
z2d(:,:) =0._wp z2d(:,:) = 0._wp
jk = 1 DO_2D( 0, 0, 0, 0 )
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ztemp = z3d(ji,jj,1) / c14sbc(ji,jj)
ztemp = zres(ji,jj) / c14sbc(ji,jj) IF( ztemp > 0._wp .AND. tmask(ji,jj,1) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
IF( ztemp > 0._wp .AND. tmask(ji,jj,jk) > 0._wp ) z2d(ji,jj) = LOG( ztemp )
END_2D END_2D
CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr]
! !
z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp ) z3d(:,:,:) = 1.d03 * ( z3d(:,:,:) - 1._wp )
CALL iom_put( "DeltaC14" , z3d(:,:,:) ) ! Delta C14 [permil] CALL iom_put( "DeltaC14" , z3d(:,:,:) ) ! Delta C14 [permil]
CALL iom_put( "C14Age" , zage * zz3d(:,:,:) ) ! Radiocarbon age [yr]
CALL iom_put( "qtr_c14", rsiyea * qtr_c14(:,:) ) ! Radiocarbon surf flux [./m2/yr]
CALL iom_put( "qint_c14" , qint_c14 ) ! cumulative flux [./m2]
CALL iom_put( "RAge" , zage * z2d(:,:) ) ! Reservoir age [yr]
! !
DEALLOCATE( z2d, zres, z3d, zz3d ) DEALLOCATE( z2d, z3d )
! !
ENDIF ENDIF
! !
...@@ -91,23 +85,35 @@ CONTAINS ...@@ -91,23 +85,35 @@ CONTAINS
! !
CALL iom_put( "AtmCO2", co2sbc ) ! global atmospheric CO2 [ppm] CALL iom_put( "AtmCO2", co2sbc ) ! global atmospheric CO2 [ppm]
IF( iom_use("AtmC14") ) THEN IF( iom_use("AtmC14") .OR. iom_use("K_C14") .OR. iom_use("K_CO2") ) THEN
zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface
ztemp = glob_sum( 'trcwri_c14', c14sbc(:,:) * e1e2t(:,:) )
ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp
CALL iom_put( "AtmC14" , ztemp ) ! Global atmospheric DeltaC14 [permil]
ENDIF
IF( iom_use("K_C14") ) THEN
ztemp = glob_sum ( 'trcwri_c14', exch_c14(:,:) * e1e2t(:,:) )
ztemp = rsiyea * ztemp / zarea
CALL iom_put( "K_C14" , ztemp ) ! global mean exchange velocity for C14/C ratio [m/yr]
ENDIF
IF( iom_use("K_CO2") ) THEN
zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface
ztemp = glob_sum ( 'trcwri_c14', exch_co2(:,:) * e1e2t(:,:) ) ALLOCATE( z2d(A2D(0)) )
ztemp = 360000._wp * ztemp / zarea ! cm/h units: directly comparable with literature IF( iom_use("AtmC14") ) THEN
CALL iom_put( "K_CO2", ztemp ) ! global mean CO2 piston velocity [cm/hr] DO_2D( 0, 0, 0, 0 )
ENDIF z2d(ji,jj) = c14sbc(ji,jj) * e1e2t(ji,jj)
END_2D
ztemp = glob_sum( 'trcwri_c14', z2d(:,:) )
ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp
CALL iom_put( "AtmC14" , ztemp ) ! Global atmospheric DeltaC14 [permil]
ENDIF
IF( iom_use("K_C14") ) THEN
DO_2D( 0, 0, 0, 0 )
z2d(ji,jj) = exch_c14(ji,jj) * e1e2t(ji,jj)
END_2D
ztemp = glob_sum( 'trcwri_c14', z2d(:,:) )
ztemp = rsiyea * ztemp / zarea
CALL iom_put( "K_C14" , ztemp ) ! global mean exchange velocity for C14/C ratio [m/yr]
ENDIF
IF( iom_use("K_CO2") ) THEN
DO_2D( 0, 0, 0, 0 )
z2d(ji,jj) = exch_co2(ji,jj) * e1e2t(ji,jj)
END_2D
ztemp = glob_sum( 'trcwri_c14', z2d(:,:) )
ztemp = 360000._wp * ztemp / zarea ! cm/h units: directly comparable with literature
CALL iom_put( "K_CO2", ztemp ) ! global mean CO2 piston velocity [cm/hr]
ENDIF
DEALLOCATE( z2d )
END IF
IF( iom_use("C14Inv") ) THEN IF( iom_use("C14Inv") ) THEN
ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) ) ztemp = glob_sum( 'trcwri_c14', tr(:,:,:,jp_c14,Kmm) * cvol(:,:,:) )
ztemp = atomc14 * xdicsur * ztemp ztemp = atomc14 * xdicsur * ztemp
......
src/TOP/CFC/trcini_cfc.F90
View file @ c72255b2
...@@ -131,7 +131,7 @@ CONTAINS ...@@ -131,7 +131,7 @@ CONTAINS
! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn ! Linear interpolation between 2 hemispheric function of latitud between ylats and ylatn
!--------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------
zyd = ylatn - ylats zyd = ylatn - ylats
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) DO_2D( 0, 0, 0, 0 )
IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0 IF( gphit(ji,jj) >= ylatn ) THEN ; xphem(ji,jj) = 1.e0
ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0 ELSEIF( gphit(ji,jj) <= ylats ) THEN ; xphem(ji,jj) = 0.e0
ELSE ; xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd ELSE ; xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd
......
src/TOP/CFC/trcsms_cfc.F90
View file @ c72255b2
...@@ -124,9 +124,9 @@ CONTAINS ...@@ -124,9 +124,9 @@ CONTAINS
& + atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12. & + atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12.
END DO END DO
! !------------! ! !------------!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! i-j loop ! DO_2D( 0, 0, 0, 0 ) ! i-j loop !
! !------------! ! !------------!
! space interpolation ! space interpolation
zpp_cfc = xphem(ji,jj) * zpatm(1,jl) & zpp_cfc = xphem(ji,jj) * zpatm(1,jl) &
& + ( 1.- xphem(ji,jj) ) * zpatm(2,jl) & + ( 1.- xphem(ji,jj) ) * zpatm(2,jl)
...@@ -309,8 +309,8 @@ CONTAINS ...@@ -309,8 +309,8 @@ CONTAINS
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
!! *** ROUTINE trc_sms_cfc_alloc *** !! *** ROUTINE trc_sms_cfc_alloc ***
!!---------------------------------------------------------------------- !!----------------------------------------------------------------------
ALLOCATE( xphem (jpi,jpj) , atm_cfc(jpyear,jphem,jp_cfc) , & ALLOCATE( xphem (A2D(0)) , atm_cfc(jpyear,jphem,jp_cfc) , &
& qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc) , & & qtr_cfc (A2D(0),jp_cfc) , qint_cfc(A2D(0),jp_cfc) , &
& soa(4,jp_cfc) , sob(3,jp_cfc) , sca(5,jp_cfc) , & & soa(4,jp_cfc) , sob(3,jp_cfc) , sca(5,jp_cfc) , &
& STAT=trc_sms_cfc_alloc ) & STAT=trc_sms_cfc_alloc )
! !
......
src/TOP/PISCES/P2Z/p2zbio.F90
View file @ c72255b2
...@@ -104,7 +104,6 @@ CONTAINS ...@@ -104,7 +104,6 @@ CONTAINS
! !
IF( ln_timing ) CALL timing_start('p2z_bio') IF( ln_timing ) CALL timing_start('p2z_bio')
! !
IF( lk_iomput ) ALLOCATE( zw2d(jpi,jpj,17), zw3d(jpi,jpj,jpk,3) )
IF( kt == nittrc000 ) THEN IF( kt == nittrc000 ) THEN
IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)
...@@ -112,18 +111,18 @@ CONTAINS ...@@ -112,18 +111,18 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' ~~~~~~~' IF(lwp) WRITE(numout,*) ' ~~~~~~~'
ENDIF ENDIF
xksi(:,:) = 0.e0 ! zooplakton closure ( fbod)
IF( lk_iomput ) THEN IF( lk_iomput ) THEN
zw2d (:,:,:) = 0._wp ALLOCATE( zw3d(A2D(0),jpk,3) ) ; zw3d(:,:,jpk,:) = 0._wp
zw3d(:,:,:,:) = 0._wp ALLOCATE( zw2d(A2D(0),17) )
ENDIF ENDIF
!
xksi(:,:) = 0.e0 ! zooplakton closure ( fbod)
! ! -------------------------- ! ! ! -------------------------- !
DO jk = 1, jpkbm1 ! Upper ocean (bio-layers) ! DO_3D( 0, 0, 0, 0, 1, jpkbm1 ) ! Upper ocean (bio-layers) !
! ! -------------------------- ! ! ! -------------------------- !
DO_2D( 0, 0, 0, 0 ) ! trophic variables( det, zoo, phy, no3, nh4, dom)
! trophic variables( det, zoo, phy, no3, nh4, dom) ! ------------------------------------------------
! ------------------------------------------------
! negative trophic variables DO not contribute to the fluxes ! negative trophic variables DO not contribute to the fluxes
zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) ) zdet = MAX( 0.e0, tr(ji,jj,jk,jpdet,Kmm) )
...@@ -235,13 +234,11 @@ CONTAINS ...@@ -235,13 +234,11 @@ CONTAINS
zw3d(ji,jj,jk,3) = znh4no3 * 86400 zw3d(ji,jj,jk,3) = znh4no3 * 86400
! !
ENDIF ENDIF
END_2D END_3D
END DO
! ! -------------------------- ! ! ! -------------------------- !
DO jk = jpkb, jpkm1 ! Upper ocean (bio-layers) ! DO_3D( 0, 0, 0, 0, jpkb, jpkm1 ) ! Upper ocean (bio-layers) !
! ! -------------------------- ! ! ! -------------------------- !
DO_2D( 0, 0, 0, 0 )
! remineralisation of all quantities towards nitrate ! remineralisation of all quantities towards nitrate
! trophic variables( det, zoo, phy, no3, nh4, dom) ! trophic variables( det, zoo, phy, no3, nh4, dom)
...@@ -334,12 +331,9 @@ CONTAINS ...@@ -334,12 +331,9 @@ CONTAINS
zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp zw3d(ji,jj,jk,3) = znh4no3 * 86400._wp
! !
ENDIF ENDIF
END_2D END_3D
END DO
! !
IF( lk_iomput ) THEN IF( lk_iomput ) THEN
CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1.0_wp )
CALL lbc_lnk( 'p2zbio', zw3d(:,:,:,1),'T', 1.0_wp, zw3d(:,:,:,2),'T', 1.0_wp, zw3d(:,:,:,3),'T', 1.0_wp )
! Save diagnostics ! Save diagnostics
CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) CALL iom_put( "TNO3PHY", zw2d(:,:,1) )
CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) CALL iom_put( "TNH4PHY", zw2d(:,:,2) )
...@@ -362,6 +356,8 @@ CONTAINS ...@@ -362,6 +356,8 @@ CONTAINS
CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) )
CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) )
! !
DEALLOCATE( zw2d, zw3d )
!
ENDIF ENDIF
IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging)
......