Changeset 10425 for NEMO/trunk/src/OCE/DIA
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/DIA
- Files:
-
- 8 edited
-
diaar5.F90 (modified) (10 diffs)
-
diacfl.F90 (modified) (2 diffs)
-
diadct.F90 (modified) (2 diffs)
-
diaharm.F90 (modified) (2 diffs)
-
diahsb.F90 (modified) (6 diffs)
-
diahth.F90 (modified) (2 diffs)
-
diaptr.F90 (modified) (4 diffs)
-
diawri.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DIA/diaar5.F90
r10068 r10425 56 56 ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 57 57 ! 58 IF( lk_mpp ) CALL mpp_sum (dia_ar5_alloc )59 IF( dia_ar5_alloc /= 0 ) CALL ctl_ warn('dia_ar5_alloc: failed to allocate arrays')58 CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 59 IF( dia_ar5_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_alloc: failed to allocate arrays' ) 60 60 ! 61 61 END FUNCTION dia_ar5_alloc … … 95 95 ! ! total volume of liquid seawater 96 96 zvolssh = SUM( zarea_ssh(:,:) ) 97 IF( lk_mpp ) CALL mpp_sum(zvolssh )97 CALL mpp_sum( 'diaar5', zvolssh ) 98 98 zvol = vol0 + zvolssh 99 99 … … 130 130 ! 131 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 132 IF( lk_mpp ) CALL mpp_sum(zarho )132 CALL mpp_sum( 'diaar5', zarho ) 133 133 zssh_steric = - zarho / area_tot 134 134 CALL iom_put( 'sshthster', zssh_steric ) … … 156 156 ! 157 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 IF( lk_mpp ) CALL mpp_sum(zarho )158 CALL mpp_sum( 'diaar5', zarho ) 159 159 zssh_steric = - zarho / area_tot 160 160 CALL iom_put( 'sshsteric', zssh_steric ) … … 194 194 ENDIF 195 195 IF( lk_mpp ) THEN 196 CALL mpp_sum( ztemp )197 CALL mpp_sum( zsal )196 CALL mpp_sum( 'diaar5', ztemp ) 197 CALL mpp_sum( 'diaar5', zsal ) 198 198 END IF 199 199 ! … … 245 245 ENDIF 246 246 !!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj 247 !!gm CALL lbc_lnk( zpe, 'T', 1._wp)247 !!gm CALL lbc_lnk( 'diaar5', zpe, 'T', 1._wp) 248 248 CALL iom_put( 'tnpeo', zpe ) 249 249 DEALLOCATE( zpe ) … … 285 285 END DO 286 286 END DO 287 CALL lbc_lnk( z2d, 'U', -1. )287 CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 288 288 IF( cptr == 'adv' ) THEN 289 289 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in i-direction … … 303 303 END DO 304 304 END DO 305 CALL lbc_lnk( z2d, 'V', -1. )305 CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 306 306 IF( cptr == 'adv' ) THEN 307 307 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in j-direction … … 342 342 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 343 343 344 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum(area_tot )344 area_tot = SUM( area(:,:) ) ; CALL mpp_sum( 'diaar5', area_tot ) 345 345 346 346 vol0 = 0._wp … … 350 350 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 351 351 END DO 352 IF( lk_mpp ) CALL mpp_sum(vol0 )352 CALL mpp_sum( 'diaar5', vol0 ) 353 353 354 354 IF( iom_use( 'sshthster' ) ) THEN -
NEMO/trunk/src/OCE/DIA/diacfl.F90
r10068 r10425 54 54 INTEGER, INTENT(in) :: kt ! ocean time-step index 55 55 ! 56 INTEGER :: ji, jj, jk! dummy loop indices57 REAL(wp) :: z2dt, zCu_max, zCv_max, zCw_max ! local scalars58 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc! workspace56 INTEGER :: ji, jj, jk ! dummy loop indices 57 REAL(wp) :: z2dt, zCu_max, zCv_max, zCw_max ! local scalars 58 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace 59 59 !!gm this does not work REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace 60 60 !!---------------------------------------------------------------------- … … 80 80 ! ! calculate maximum values and locations 81 81 IF( lk_mpp ) THEN 82 CALL mpp_maxloc( zCu_cfl, umask, zCu_max, iloc_u(1), iloc_u(2), iloc_u(3))83 CALL mpp_maxloc( zCv_cfl, vmask, zCv_max, iloc_v(1), iloc_v(2), iloc_v(3))84 CALL mpp_maxloc( zCw_cfl, wmask, zCw_max, iloc_w(1), iloc_w(2), iloc_w(3))82 CALL mpp_maxloc( 'diacfl', zCu_cfl, umask, zCu_max, iloc_u ) 83 CALL mpp_maxloc( 'diacfl', zCv_cfl, vmask, zCv_max, iloc_v ) 84 CALL mpp_maxloc( 'diacfl', zCw_cfl, wmask, zCw_max, iloc_w ) 85 85 ELSE 86 86 iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) -
NEMO/trunk/src/OCE/DIA/diadct.F90
r10068 r10425 115 115 116 116 diadct_alloc = MAXVAL( ierr ) 117 IF( diadct_alloc /= 0 ) CALL ctl_ warn('diadct_alloc: failed to allocate arrays')117 IF( diadct_alloc /= 0 ) CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 118 118 119 119 END FUNCTION diadct_alloc … … 258 258 DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport(:,:) ; ENDDO 259 259 zwork(:)= RESHAPE(zsum(:,:,:), ish ) 260 CALL mpp_sum( zwork, ish(1))260 CALL mpp_sum('diadct', zwork, ish(1)) 261 261 zsum(:,:,:)= RESHAPE(zwork,ish2) 262 262 DO jsec=1,nb_sec ; secs(jsec)%transport(:,:) = zsum(jsec,:,:) ; ENDDO -
NEMO/trunk/src/OCE/DIA/diaharm.F90
r10068 r10425 22 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 23 USE timing ! preformance summary 24 USE lib_mpp ! MPP library 24 25 25 26 IMPLICIT NONE … … 126 127 ! 127 128 IF (nb_ana > jpmax_harmo) THEN 128 IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nb_ana must be lower than jpmax_harmo, stop'129 IF(lwp) WRITE(numout,*) ' jpmax_harmo= ', jpmax_harmo130 nstop = nstop + 1129 WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//TRIM(clname)//', var:'//TRIM(cdvar) 130 WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 131 CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 131 132 ENDIF 132 133 -
NEMO/trunk/src/OCE/DIA/diahsb.F90
r10068 r10425 91 91 ! 1 - Trends due to forcing ! 92 92 ! ------------------------- ! 93 z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes94 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes95 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes93 z_frc_trd_v = r1_rau0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes 94 z_frc_trd_t = glob_sum( 'diahsb', sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 95 z_frc_trd_s = glob_sum( 'diahsb', sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 96 96 ! ! Add runoff heat & salt input 97 IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) )98 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) )97 IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', rnf_tsc(:,:,jp_tem) * surf(:,:) ) 98 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( 'diahsb', rnf_tsc(:,:,jp_sal) * surf(:,:) ) 99 99 ! ! Add ice shelf heat & salt input 100 IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) )100 IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', risf_tsc(:,:,jp_tem) * surf(:,:) ) 101 101 ! ! Add penetrative solar radiation 102 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) )102 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( 'diahsb', qsr (:,:) * surf(:,:) ) 103 103 ! ! Add geothermal heat flux 104 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) )104 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( 'diahsb', qgh_trd0(:,:) * surf(:,:) ) 105 105 ! 106 106 IF( ln_linssh ) THEN … … 116 116 z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 117 117 END IF 118 z_wn_trd_t = - glob_sum( z2d0 )119 z_wn_trd_s = - glob_sum( z2d1 )118 z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 119 z_wn_trd_s = - glob_sum( 'diahsb', z2d1 ) 120 120 ENDIF 121 121 … … 135 135 136 136 ! ! volume variation (calculated with ssh) 137 zdiff_v1 = glob_sum_full( surf(:,:)*sshn(:,:) - surf_ini(:,:)*ssh_ini(:,:) )137 zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*sshn(:,:) - surf_ini(:,:)*ssh_ini(:,:) ) 138 138 139 139 ! ! heat & salt content variation (associated with ssh) … … 150 150 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 151 151 END IF 152 z_ssh_hc = glob_sum_full( z2d0 )153 z_ssh_sc = glob_sum_full( z2d1 )154 ENDIF 155 ! 156 DO jk = 1, jpkm1 ! volume variation (calculated with scale factors)152 z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 153 z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 154 ENDIF 155 ! 156 DO jk = 1, jpkm1 ! volume variation (calculated with scale factors) 157 157 zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk) 158 158 END DO 159 zdiff_v2 = glob_sum_full( zwrk(:,:,:) )159 zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 160 160 DO jk = 1, jpkm1 ! heat content variation 161 161 zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_tem) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 162 162 END DO 163 zdiff_hc = glob_sum_full( zwrk(:,:,:) )163 zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 164 164 DO jk = 1, jpkm1 ! salt content variation 165 165 zwrk(:,:,jk) = ( surf(:,:)*e3t_n(:,:,jk)*tsn(:,:,jk,jp_sal) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 166 166 END DO 167 zdiff_sc = glob_sum_full( zwrk(:,:,:) )167 zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 168 168 169 169 ! ------------------------ ! … … 187 187 zwrk(:,:,jk) = surf(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 188 188 END DO 189 zvol_tot = glob_sum_full( zwrk(:,:,:) )189 zvol_tot = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 190 190 191 191 !!gm to be added ? 192 192 ! IF( ln_linssh ) THEN ! fixed volume, add the ssh contribution 193 ! zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) )193 ! zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * sshn(:,:) ) 194 194 ! ENDIF 195 195 !!gm end … … 409 409 ! 2 - Time independant variables and file opening ! 410 410 ! ----------------------------------------------- ! 411 surf(:,:) = e1e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area412 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area411 surf(:,:) = e1e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 412 surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area 413 413 414 414 IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) -
NEMO/trunk/src/OCE/DIA/diahth.F90
r10068 r10425 54 54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc ) 55 55 ! 56 IF( lk_mpp ) CALL mpp_sum (dia_hth_alloc )57 IF(dia_hth_alloc /= 0) CALL ctl_ warn('dia_hth_alloc: failed to allocate arrays.')56 CALL mpp_sum ( 'diahth', dia_hth_alloc ) 57 IF(dia_hth_alloc /= 0) CALL ctl_stop( 'STOP', 'dia_hth_alloc: failed to allocate arrays.' ) 58 58 ! 59 59 END FUNCTION dia_hth_alloc … … 123 123 & zthick(jpi,jpj), & 124 124 & zdelr(jpi,jpj), STAT=ji) 125 IF( lk_mpp ) CALL mpp_sum(ji)125 CALL mpp_sum('diahth', ji) 126 126 IF( ji /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' ) 127 127 END IF -
NEMO/trunk/src/OCE/DIA/diaptr.F90
r10068 r10425 549 549 ! 550 550 dia_ptr_alloc = MAXVAL( ierr ) 551 IF(lk_mpp) CALL mpp_sum(dia_ptr_alloc )551 CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 552 552 ! 553 553 END FUNCTION dia_ptr_alloc … … 595 595 ENDIF 596 596 #if defined key_mpp_mpi 597 IF(lk_mpp) CALL mpp_sum(p_fval, ijpj, ncomm_znl)597 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) 598 598 #endif 599 599 ! … … 638 638 ENDIF 639 639 #if defined key_mpp_mpi 640 CALL mpp_sum( p_fval, ijpj, ncomm_znl )640 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) 641 641 #endif 642 642 ! … … 696 696 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 697 697 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 698 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )698 CALL mpp_sum( 'diaptr', zwork, ijpjjpk, ncomm_znl ) 699 699 p_fval(:,:) = RESHAPE( zwork, ish2 ) 700 700 #endif -
NEMO/trunk/src/OCE/DIA/diawri.F90
r10114 r10425 52 52 53 53 #if defined key_si3 54 USE ice 54 55 USE icewri 55 56 #endif … … 119 120 ! Output the initial state and forcings 120 121 IF( ninist == 1 ) THEN 121 CALL dia_wri_state( 'output.init' , kt)122 CALL dia_wri_state( 'output.init' ) 122 123 ninist = 0 123 124 ENDIF … … 181 182 END DO 182 183 END DO 183 CALL lbc_lnk( z2d, 'T', 1. )184 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 184 185 CALL iom_put( "taubot", z2d ) 185 186 ENDIF … … 237 238 END DO 238 239 END DO 239 CALL lbc_lnk( z2d, 'T', 1. )240 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 240 241 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 241 242 z2d(:,:) = SQRT( z2d(:,:) ) … … 281 282 END DO 282 283 END DO 283 CALL lbc_lnk( z3d, 'T', 1. )284 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 284 285 CALL iom_put( "eken", z3d ) ! kinetic energy 285 286 ENDIF … … 307 308 END DO 308 309 END DO 309 CALL lbc_lnk( z2d, 'U', -1. )310 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 310 311 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 311 312 ENDIF … … 320 321 END DO 321 322 END DO 322 CALL lbc_lnk( z2d, 'U', -1. )323 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 323 324 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 324 325 ENDIF … … 342 343 END DO 343 344 END DO 344 CALL lbc_lnk( z2d, 'V', -1. )345 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 345 346 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 346 347 ENDIF … … 355 356 END DO 356 357 END DO 357 CALL lbc_lnk( z2d, 'V', -1. )358 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 358 359 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 359 360 ENDIF … … 368 369 END DO 369 370 END DO 370 CALL lbc_lnk( z2d, 'T', -1. )371 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 371 372 CALL iom_put( "tosmint", rau0 * z2d ) ! Vertical integral of temperature 372 373 ENDIF … … 380 381 END DO 381 382 END DO 382 CALL lbc_lnk( z2d, 'T', -1. )383 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 383 384 CALL iom_put( "somint", rau0 * z2d ) ! Vertical integral of salinity 384 385 ENDIF … … 410 411 ! 411 412 dia_wri_alloc = MAXVAL(ierr) 412 IF( lk_mpp ) CALL mpp_sum(dia_wri_alloc )413 CALL mpp_sum( 'diawri', dia_wri_alloc ) 413 414 ! 414 415 END FUNCTION dia_wri_alloc … … 445 446 ! 446 447 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 447 CALL dia_wri_state( 'output.init' , kt)448 CALL dia_wri_state( 'output.init' ) 448 449 ninist = 0 449 450 ENDIF … … 519 520 !! that routine is called from nemogcm, so do it here immediately before its needed 520 521 ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 521 IF( lk_mpp ) CALL mpp_sum(ierror )522 CALL mpp_sum( 'diawri', ierror ) 522 523 IF( ierror /= 0 ) THEN 523 524 CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') … … 868 869 #endif 869 870 870 SUBROUTINE dia_wri_state( cdfile_name , kt)871 SUBROUTINE dia_wri_state( cdfile_name ) 871 872 !!--------------------------------------------------------------------- 872 873 !! *** ROUTINE dia_wri_state *** … … 882 883 !!---------------------------------------------------------------------- 883 884 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 884 INTEGER , INTENT( in ) :: kt ! ocean time-step index 885 !! 886 CHARACTER (len=32) :: clname 887 CHARACTER (len=40) :: clop 888 INTEGER :: id_i , nz_i, nh_i 889 INTEGER, DIMENSION(1) :: idex ! local workspace 890 REAL(wp) :: zsto, zout, zmax, zjulian 885 !! 886 INTEGER :: inum 891 887 !!---------------------------------------------------------------------- 892 888 ! 893 ! 0. Initialisation894 ! -----------------895 896 ! Define name, frequency of output and means897 clname = cdfile_name898 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)899 zsto = rdt900 clop = "inst(x)" ! no use of the mask value (require less cpu time)901 zout = rdt902 zmax = ( nitend - nit000 + 1 ) * rdt903 904 889 IF(lwp) WRITE(numout,*) 905 890 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 906 891 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 907 IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc' 908 909 910 ! 1. Define NETCDF files and fields at beginning of first time step 911 ! ----------------------------------------------------------------- 912 913 ! Compute julian date from starting date of the run 914 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis 915 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 916 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 917 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 918 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 919 "m", jpk, gdept_1d, nz_i, "down") 920 921 ! Declare all the output fields as NetCDF variables 922 923 CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity 924 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 925 CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature 926 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 927 CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh 928 & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout ) 929 CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current 930 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 931 CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current 932 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 933 CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current 934 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 935 ! 892 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 893 894 #if defined key_si3 895 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 896 #else 897 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 898 #endif 899 900 CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) ) ! now temperature 901 CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) ) ! now salinity 902 CALL iom_rstput( 0, 0, inum, 'sossheig', sshn ) ! sea surface height 903 CALL iom_rstput( 0, 0, inum, 'vozocrtx', un ) ! now i-velocity 904 CALL iom_rstput( 0, 0, inum, 'vomecrty', vn ) ! now j-velocity 905 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn ) ! now k-velocity 936 906 IF( ALLOCATED(ahtu) ) THEN 937 CALL histdef( id_i, "ahtu" , "u-eddy diffusivity" , "m2/s" , & ! zonal current 938 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 939 CALL histdef( id_i, "ahtv" , "v-eddy diffusivity" , "m2/s" , & ! meridonal current 940 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 941 ENDIF 942 IF( ALLOCATED(ahmt) ) THEN 943 CALL histdef( id_i, "ahmt" , "t-eddy viscosity" , "m2/s" , & ! zonal current 944 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 945 CALL histdef( id_i, "ahmf" , "f-eddy viscosity" , "m2/s" , & ! meridonal current 946 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 947 ENDIF 948 ! 949 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 950 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 951 CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux 952 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 953 CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux 954 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 955 CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i 956 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 957 CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress 958 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 959 CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress 960 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 961 IF( .NOT.ln_linssh ) THEN 962 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 963 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 964 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 965 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 966 ENDIF 967 ! 907 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point 908 CALL iom_rstput( 0, 0, inum, 'ahtv', ahtv ) ! aht at v-point 909 ENDIF 910 IF( ALLOCATED(ahmt) ) THEN 911 CALL iom_rstput( 0, 0, inum, 'ahmt', ahmt ) ! ahmt at u-point 912 CALL iom_rstput( 0, 0, inum, 'ahmf', ahmf ) ! ahmf at v-point 913 ENDIF 914 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 915 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux 916 CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux 917 CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction 918 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 919 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 920 IF( .NOT.ln_linssh ) THEN 921 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept_n ) ! T-cell depth 922 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t_n ) ! T-cell thickness 923 END IF 968 924 IF( ln_wave .AND. ln_sdw ) THEN 969 CALL histdef( id_i, "sdzocrtx", "Stokes Drift Zonal" , "m/s" , & ! StokesDrift zonal current 970 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 971 CALL histdef( id_i, "sdmecrty", "Stokes Drift Merid" , "m/s" , & ! StokesDrift meridonal current 972 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 973 CALL histdef( id_i, "sdvecrtz", "Stokes Drift Vert" , "m/s" , & ! StokesDrift vertical current 974 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 975 ENDIF 976 925 CALL iom_rstput( 0, 0, inum, 'sdzocrtx', usd ) ! now StokesDrift i-velocity 926 CALL iom_rstput( 0, 0, inum, 'sdmecrty', vsd ) ! now StokesDrift j-velocity 927 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 928 ENDIF 929 977 930 #if defined key_si3 978 931 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 979 CALL ice_wri_state( kt, id_i, nh_i ) 980 ENDIF 981 #else 982 CALL histend( id_i, snc4chunks=snc4set ) 932 CALL ice_wri_state( inum ) 933 ENDIF 983 934 #endif 984 985 ! 2. Start writing data 986 ! --------------------- 987 ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 988 ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument 989 ! donne le nombre d'elements, et idex la liste des indices a sortir 990 idex(1) = 1 ! init to avoid compil warning 991 992 ! Write all fields on T grid 993 CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex ) ! now temperature 994 CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex ) ! now salinity 995 CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height 996 CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity 997 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 998 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 999 ! 1000 IF( ALLOCATED(ahtu) ) THEN 1001 CALL histwrite( id_i, "ahtu" , kt, ahtu , jpi*jpj*jpk, idex ) ! aht at u-point 1002 CALL histwrite( id_i, "ahtv" , kt, ahtv , jpi*jpj*jpk, idex ) ! - at v-point 1003 ENDIF 1004 IF( ALLOCATED(ahmt) ) THEN 1005 CALL histwrite( id_i, "ahmt" , kt, ahmt , jpi*jpj*jpk, idex ) ! ahm at t-point 1006 CALL histwrite( id_i, "ahmf" , kt, ahmf , jpi*jpj*jpk, idex ) ! - at f-point 1007 ENDIF 1008 ! 1009 CALL histwrite( id_i, "sowaflup", kt, emp - rnf , jpi*jpj , idex ) ! freshwater budget 1010 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 1011 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux 1012 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction 1013 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 1014 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 1015 1016 IF( .NOT.ln_linssh ) THEN 1017 CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 1018 CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )! T-cell thickness 1019 END IF 1020 1021 IF( ln_wave .AND. ln_sdw ) THEN 1022 CALL histwrite( id_i, "sdzocrtx", kt, usd , jpi*jpj*jpk, idex) ! now StokesDrift i-velocity 1023 CALL histwrite( id_i, "sdmecrty", kt, vsd , jpi*jpj*jpk, idex) ! now StokesDrift j-velocity 1024 CALL histwrite( id_i, "sdvecrtz", kt, wsd , jpi*jpj*jpk, idex) ! now StokesDrift k-velocity 1025 ENDIF 1026 1027 ! 3. Close the file 1028 ! ----------------- 1029 CALL histclo( id_i ) 1030 #if ! defined key_iomput 1031 IF( ninist /= 1 ) THEN 1032 CALL histclo( nid_T ) 1033 CALL histclo( nid_U ) 1034 CALL histclo( nid_V ) 1035 CALL histclo( nid_W ) 1036 ENDIF 1037 #endif 935 ! 936 CALL iom_close( inum ) 1038 937 ! 1039 938 END SUBROUTINE dia_wri_state
Note: See TracChangeset
for help on using the changeset viewer.
