MODULE diawri !!====================================================================== !! *** MODULE diawri *** !! Ocean diagnostics : write ocean output files !!===================================================================== !!---------------------------------------------------------------------- !! * Modules used USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE zdf_oce ! ocean vertical physics USE ldftra_oce ! ocean active tracers: lateral physics USE ldfdyn_oce ! ocean dynamics: lateral physics USE sol_oce ! solver variables USE ice_oce ! ice variables USE sbc_oce ! Surface boundary condition: ocean fields USE sbc_ice ! Surface boundary condition: ice fields USE sbcssr ! restoring term toward SST/SSS climatology USE phycst ! physical constants USE zdfmxl ! mixed layer USE daymod ! calendar USE dianam ! build name of file (routine) USE zdfddm ! vertical physics: double diffusion USE diahth ! thermocline diagnostics USE diaspr ! surface pressure diagnostics (rigid lid case) USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE in_out_manager ! I/O manager USE diadimg ! dimg direct access file format output USE ioipsl IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC dia_wri ! routines called by step.F90 PUBLIC dia_wri_state !! * Module variables INTEGER :: & nid_T, nz_T, nh_T, ndim_T, ndim_hT, & ! grid_T file nid_U, nz_U, nh_U, ndim_U, ndim_hU, & ! grid_U file nid_V, nz_V, nh_V, ndim_V, ndim_hV, & ! grid_V file nid_W, nz_W, nh_W, & ! grid_W file ndex(1) ! ??? INTEGER, DIMENSION(jpi*jpj) :: & ndex_hT, ndex_hU, ndex_hV INTEGER, DIMENSION(jpi*jpj*jpk) :: & ndex_T, ndex_U, ndex_V !! * Substitutions # include "zdfddm_substitute.h90" !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Id$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- CONTAINS #if defined key_dimgout !!---------------------------------------------------------------------- !! dia_wri : create the dimg direct access output file (mpp) !!---------------------------------------------------------------------- # include "diawri_dimg.h90" #else !!---------------------------------------------------------------------- !! Default option NetCDF output file !!---------------------------------------------------------------------- !! dia_wri : create the standart NetCDF output files !! dia_wri_state : create an output NetCDF file for a single !! instantaeous ocean state and forcing fields !!---------------------------------------------------------------------- SUBROUTINE dia_wri( kt, kindic ) !!--------------------------------------------------------------------- !! *** ROUTINE dia_wri *** !! !! ** Purpose : Standard output of opa: dynamics and tracer fields !! NETCDF format is used by default !! !! ** Method : At the beginning of the first time step (nit000), !! define all the NETCDF files and fields !! At each time step call histdef to compute the mean if ncessary !! Each nwrite time step, output the instantaneous or mean fields !! IF kindic <0, output of fields before the model interruption. !! IF kindic =0, time step loop !! IF kindic >0, output of fields before the time step loop !! !! History : !! ! 91-03 (M.-A. Foujols) Original code !! ! 91-11 (G. Madec) !! ! 92-06 (M. Imbard) correction restart file !! ! 92-07 (M. Imbard) split into diawri and rstwri !! ! 93-03 (M. Imbard) suppress writibm !! ! 98-01 (C. Levy) NETCDF format using ioipsl INTERFACE !! ! 99-02 (E. Guilyardi) name of netCDF files + variables !! 8.5 ! 02-09 (G. Madec) F90: Free form and module !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time-step index INTEGER, INTENT( in ) :: kindic ! !! * Local declarations LOGICAL :: ll_print = .FALSE. ! =T print and flush numout CHARACTER (len=40) :: & clhstnam, clop, clmx ! temporary names INTEGER :: inum = 11 ! temporary logical unit INTEGER :: & iimi, iima, ipk, it, & ! temporary integers ijmi, ijma ! " " REAL(wp) :: & zsto, zout, zmax, & ! temporary scalars zjulian, zdt ! " " REAL(wp), DIMENSION(jpi,jpj) :: & zw2d ! temporary workspace CHARACTER (len=80) :: clname !!---------------------------------------------------------------------- ! 0. Initialisation ! ----------------- ! local variable for debugging ll_print = .FALSE. ll_print = ll_print .AND. lwp ! Define frequency of output and means zdt = rdt IF( nacc == 1 ) zdt = rdtmin IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) ELSE ; clop = "x" ! no use of the mask value (require less cpu time) ENDIF #if defined key_diainstant zsto = nwrite * zdt clop = "inst("//TRIM(clop)//")" #else zsto=zdt clop = "ave("//TRIM(clop)//")" #endif zout = nwrite * zdt zmax = ( nitend - nit000 + 1 ) * zdt ! Define indices of the horizontal output zoom and vertical limit storage iimi = 1 ; iima = jpi ijmi = 1 ; ijma = jpj ipk = jpk ! define time axis it = kt - nit000 + 1 ! 1. Define NETCDF files and fields at beginning of first time step ! ----------------------------------------------------------------- IF(ll_print) WRITE(numout,*) 'dia_wri kt = ', kt, ' kindic ', kindic IF( kt == nit000 ) THEN ! Define the NETCDF files (one per grid) ! Compute julian date from starting date of the run CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment IF(lwp)WRITE(numout,*) IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear, & & ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & ' limit storage in depth = ', ipk ! WRITE root name in date.file for use by postpro IF( lwp) THEN CALL dia_nam( clhstnam, nwrite,' ' ) clname = 'date.file' CALL ctlopn( inum, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) WRITE(inum,*) clhstnam CLOSE(inum) ENDIF ! Define the T grid FILE ( nid_T ) CALL dia_nam( clhstnam, nwrite, 'grid_T' ) IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & & 0, zjulian, zdt, nh_T, nid_T, domain_id=nidom ) CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept & "m", ipk, gdept_0, nz_T ) ! ! Index of ocean points CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T ) ! volume CALL wheneq( jpi*jpj , tmask, 1, 1., ndex_hT, ndim_hT ) ! surface ! Define the U grid FILE ( nid_U ) CALL dia_nam( clhstnam, nwrite, 'grid_U' ) IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & & 0, zjulian, zdt, nh_U, nid_U, domain_id=nidom ) CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept & "m", ipk, gdept_0, nz_U ) ! ! Index of ocean points CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U ) ! volume CALL wheneq( jpi*jpj , umask, 1, 1., ndex_hU, ndim_hU ) ! surface ! Define the V grid FILE ( nid_V ) CALL dia_nam( clhstnam, nwrite, 'grid_V' ) ! filename IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & & 0, zjulian, zdt, nh_V, nid_V, domain_id=nidom ) CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept & "m", ipk, gdept_0, nz_V ) ! ! Index of ocean points CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V ) ! volume CALL wheneq( jpi*jpj , vmask, 1, 1., ndex_hV, ndim_hV ) ! surface ! Define the W grid FILE ( nid_W ) CALL dia_nam( clhstnam, nwrite, 'grid_W' ) ! filename IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & & 0, zjulian, zdt, nh_W, nid_W, domain_id=nidom ) CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw & "m", ipk, gdepw_0, nz_W ) ! Declare all the output fields as NETCDF variables ! !!! nid_T : 3D CALL histdef( nid_T, "votemper", "Temperature" , "C" , & ! tn & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) CALL histdef( nid_T, "vosaline", "Salinity" , "PSU" , & ! sn & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) ! !!! nid_T : 2D CALL histdef( nid_T, "sosstsst", "Sea Surface temperature" , "C" , & ! sst & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sosaline", "Sea Surface Salinity" , "PSU" , & ! sss & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #if defined key_dynspg_rl CALL histdef( nid_T, "sobarstf","Barotropic StreamFunction" , "m3/s2" , & ! bsf & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #else CALL histdef( nid_T, "sossheig", "Sea Surface Height" , "m" , & ! ssh & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #endif !!$#if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) !!$ ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to !!$ ! internal damping to Levitus that can be diagnosed from others !!$ ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup !!$ CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater" , "kg/m2/s", & ! fsalt !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) !!$ CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater" , "kg/m2/s", & ! fmass !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) !!$#endif CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! emp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) !!$ CALL histdef( nid_T, "sorunoff", "Runoffs" , "Kg/m2/s", & ! runoffs !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux" , "kg/m2/s", & ! emps & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sosalflx", "Surface Salt Flux" , "Kg/m2/s", & ! emps * sn & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! qsr & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01" , "m" , & ! hmlp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "somixhgt", "Turbocline Depth" , "m" , & ! hmld & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #if ! defined key_coupled CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #endif #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping" , "Kg/m2/s", & ! erp * sn & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #endif #if defined key_diaspr CALL histdef( nid_T, "sosurfps", "Surface Pressure" , "cm" , & ! sp & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #endif clmx ="l_max(only(x))" ! max index on a period CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clmx, zsto, zout ) #if defined key_diahth CALL histdef( nid_T, "sothedep", "Thermocline Depth" , "m" , & ! hth & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm" , "m" , & ! hd20 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm" , "m" , & ! hd28 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "W" , & ! htc3 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) #endif #if defined key_coupled # if defined key_lim3 Must be adapted to LIM3 # else CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) # endif #endif CALL histend( nid_T ) ! !!! nid_U : 3D CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! un & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) #if defined key_diaeiv CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) #endif ! !!! nid_U : 2D 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 ) #if defined key_dynspg_rl CALL histdef( nid_U, "sozospgx", "Zonal Surface Pressure Gradient" , "N/kg" , & ! spgu & jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) #endif CALL histend( nid_U ) ! !!! nid_V : 3D CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vn & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) #if defined key_diaeiv CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) #endif ! !!! nid_V : 2D 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 ) #if defined key_dynspg_rl CALL histdef( nid_V, "somespgy", "Meridional Surface Pressure Grad." , "N/kg" , & ! spgv & jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) #endif CALL histend( nid_V ) ! !!! nid_W : 3D CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! wn & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) #if defined key_diaeiv CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) #endif CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) CALL histdef( nid_W, "votkeevd", "Enhanced Vertical Diffusivity", "m2/s" , & ! avt_evd & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) ! CALL histdef( nid_W, "votkeavm", "Vertical Eddy Viscosity" , "m2/s" , & ! avmu & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) CALL histdef( nid_W, "votkeevm", "Enhanced Vertical Viscosity", "m2/s" , & ! avmu_evd & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) IF( lk_zdfddm ) THEN CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity" , "m2/s" , & ! avs & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) ENDIF ! !!! nid_W : 2D #if defined key_traldf_c2d CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity" , "m2/s" , & ! ahtw & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) # if defined key_traldf_eiv CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s", & ! aeiw & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) # endif #endif CALL histend( nid_W ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization' IF(ll_print) CALL FLUSH(numout ) ENDIF ! 2. Start writing data ! --------------------- ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument ! donne le nombre d'elements, et ndex la liste des indices a sortir IF( lwp .AND. MOD( it, nwrite ) == 0 ) THEN WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step' WRITE(numout,*) '~~~~~~ ' ENDIF ! Write fields on T grid CALL histwrite( nid_T, "votemper", it, tn , ndim_T , ndex_T ) ! temperature CALL histwrite( nid_T, "vosaline", it, sn , ndim_T , ndex_T ) ! salinity CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface temperature CALL histwrite( nid_T, "sosaline", it, sn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity #if defined key_dynspg_rl CALL histwrite( nid_T, "sobarstf", it, bsfn , ndim_hT, ndex_hT ) ! barotropic streamfunction #else CALL histwrite( nid_T, "sossheig", it, sshn , ndim_hT, ndex_hT ) ! sea surface height #endif !!$#if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) !!$ CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:) , ndim_hT, ndex_hT ) ! ice=>ocean water flux !!$ CALL histwrite( nid_T, "sowaflep", it, fmass(:,:) , ndim_hT, ndex_hT ) ! atmos=>ocean water flux !!$#endif CALL histwrite( nid_T, "sowaflup", it, emp , ndim_hT, ndex_hT ) ! upward water flux !!$ CALL histwrite( nid_T, "sorunoff", it, runoff , ndim_hT, ndex_hT ) ! runoff CALL histwrite( nid_T, "sowaflcd", it, emps , ndim_hT, ndex_hT ) ! c/d water flux zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1) CALL histwrite( nid_T, "sosalflx", it, zw2d , ndim_hT, ndex_hT ) ! c/d salt flux CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux CALL histwrite( nid_T, "somxl010", it, hmlp , ndim_hT, ndex_hT ) ! mixed layer depth CALL histwrite( nid_T, "somixhgt", it, hmld , ndim_hT, ndex_hT ) ! turbocline depth CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction #if ! defined key_coupled CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1) CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping #endif #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1) CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping #endif #if defined key_diaspr CALL histwrite( nid_T, "sosurfps", it, gps , ndim_hT, ndex_hT ) ! surface pressure #endif zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) CALL histwrite( nid_T, "sobowlin", it, zw2d , ndim_hT, ndex_hT ) ! ??? #if defined key_diahth CALL histwrite( nid_T, "sothedep", it, hth , ndim_hT, ndex_hT ) ! depth of the thermocline CALL histwrite( nid_T, "so20chgt", it, hd20 , ndim_hT, ndex_hT ) ! depth of the 20 isotherm CALL histwrite( nid_T, "so28chgt", it, hd28 , ndim_hT, ndex_hT ) ! depth of the 28 isotherm CALL histwrite( nid_T, "sohtc300", it, htc3 , ndim_hT, ndex_hT ) ! first 300m heaat content #endif #if defined key_coupled # if defined key_lim3 Must be adapted for LIM3 CALL histwrite( nid_T, "soicetem", it, tn_ice , ndim_hT, ndex_hT ) ! surf. ice temperature CALL histwrite( nid_T, "soicealb", it, alb_ice , ndim_hT, ndex_hT ) ! ice albedo # else CALL histwrite( nid_T, "soicetem", it, tn_ice , ndim_hT, ndex_hT ) ! surf. ice temperature CALL histwrite( nid_T, "soicealb", it, alb_ice , ndim_hT, ndex_hT ) ! ice albedo # endif #endif ! Write fields on U grid CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current #if defined key_diaeiv CALL histwrite( nid_U, "vozoeivu", it, u_eiv , ndim_U , ndex_U ) ! i-eiv current #endif CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress #if defined key_dynspg_rl CALL lbc_lnk( spgu, 'U', -1. ) CALL histwrite( nid_U, "sozospgx", it, spgu , ndim_hU, ndex_hU ) ! i-surf. press. grad. #endif ! Write fields on V grid CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current #if defined key_diaeiv CALL histwrite( nid_V, "vomeeivv", it, v_eiv , ndim_V , ndex_V ) ! j-eiv current #endif CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress #if defined key_dynspg_rl CALL lbc_lnk( spgv, 'V', -1. ) CALL histwrite( nid_V, "somespgy", it, spgv , ndim_hV, ndex_hV ) ! j-surf. pressure grad. #endif ! Write fields on W grid CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current # if defined key_diaeiv CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current # endif CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. CALL histwrite( nid_W, "votkeevd", it, avt_evd , ndim_T, ndex_T ) ! T enhan. vert. eddy diff. coef. CALL histwrite( nid_W, "votkeavm", it, avmu , ndim_T, ndex_T ) ! T vert. eddy visc. coef. CALL histwrite( nid_W, "votkeevm", it, avmu_evd , ndim_T, ndex_T ) ! T enhan. vert. eddy visc. coef. IF( lk_zdfddm ) THEN CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T ) ! S vert. eddy diff. coef. ENDIF #if defined key_traldf_c2d CALL histwrite( nid_W, "soleahtw", it, ahtw , ndim_hT, ndex_hT ) ! lateral eddy diff. coef. # if defined key_traldf_eiv CALL histwrite( nid_W, "soleaeiw", it, aeiw , ndim_hT, ndex_hT ) ! EIV coefficient at w-point # endif #endif ! 3. Synchronise and close all files ! --------------------------------------- IF( MOD( it, nwrite ) == 0 .OR. kindic < 0 ) THEN CALL histsync( nid_T ) CALL histsync( nid_U ) CALL histsync( nid_V ) CALL histsync( nid_W ) ENDIF ! Create an output files (output.abort.nc) if S < 0 or u > 20 m/s IF( kindic < 0 ) CALL dia_wri_state( 'output.abort' ) IF( kt == nitend .OR. kindic < 0 ) THEN CALL histclo( nid_T ) CALL histclo( nid_U ) CALL histclo( nid_V ) CALL histclo( nid_W ) ENDIF END SUBROUTINE dia_wri SUBROUTINE dia_wri_state( cdfile_name ) !!--------------------------------------------------------------------- !! *** ROUTINE dia_wri_state *** !! !! ** Purpose : create a NetCDF file named cdfile_name which contains !! the instantaneous ocean state and forcing fields. !! Used to find errors in the initial state or save the last !! ocean state in case of abnormal end of a simulation !! !! ** Method : NetCDF files using ioipsl !! File 'output.init.nc' is created if ninist = 1 (namelist) !! File 'output.abort.nc' is created in case of abnormal job end !! !! History : !! 8.2 ! 00-06 (M. Imbard) Original code (diabort.F) !! 8.5 ! 02-06 (A.Bozec, E. Durand) Original code (diainit.F) !! 9.0 ! 02-12 (G. Madec) merge of diabort and diainit, F90 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- !! * Arguments CHARACTER (len=* ), INTENT( in ) :: & cdfile_name ! name of the file created !! * Local declarations CHARACTER (len=32) :: clname CHARACTER (len=40) :: clop INTEGER :: & id_i , nz_i, nh_i INTEGER, DIMENSION(1) :: & idex ! temprary workspace REAL(wp) :: & zsto, zout, zmax, & zjulian, zdt !!---------------------------------------------------------------------- ! 0. Initialisation ! ----------------- ! Define name, frequency of output and means clname = cdfile_name #if defined key_agrif if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) #endif zdt = rdt zsto = rdt clop = "inst(x)" ! no use of the mask value (require less cpu time) zout = rdt zmax = ( nitend - nit000 + 1 ) * zdt IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' IF(lwp) WRITE(numout,*) ' and named :', clname, '.nc' ! 1. Define NETCDF files and fields at beginning of first time step ! ----------------------------------------------------------------- ! Compute julian date from starting date of the run CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! time axis zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment CALL histbeg( clname, jpi, glamt, jpj, gphit, & 1, jpi, 1, jpj, 0, zjulian, zdt, nh_i, id_i, domain_id=nidom ) ! Horizontal grid : glamt and gphit CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept "m", jpk, gdept_0, nz_i) ! Declare all the output fields as NetCDF variables CALL histdef( id_i, "vosaline", "Salinity" , "PSU" , & ! salinity & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) CALL histdef( id_i, "votemper", "Temperature" , "C" , & ! temperature & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) #if defined key_dynspg_rl CALL histdef( id_i, "sobarstf","Barotropic StreamFunction", "m3/s2" , & ! bsf & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout ) #else CALL histdef( id_i, "sossheig", "Sea Surface Height" , "m" , & ! ssh & jpi, jpj, nh_i, 1 , 1, 1 , nz_i, 32, clop, zsto, zout ) #endif CALL histdef( id_i, "vozocrtx", "Zonal Current" , "m/s" , & ! zonal current & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) CALL histdef( id_i, "vomecrty", "Meridional Current" , "m/s" , & ! meridonal current & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2" , & ! net heat flux & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( id_i, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! solar flux & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( id_i, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( id_i, "sozotaux", "Zonal Wind Stress" , "N/m2" , & ! i-wind stress & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) CALL histend( id_i ) ! 2. Start writing data ! --------------------- ! idex(1) est utilise ssi l'avant dernier argument est diffferent de ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument ! donne le nombre d'elements, et idex la liste des indices a sortir idex(1) = 1 ! init to avoid compil warning ! Write all fields on T grid CALL histwrite( id_i, "votemper", 1, tn , jpi*jpj*jpk, idex ) ! now temperature CALL histwrite( id_i, "vosaline", 1, sn , jpi*jpj*jpk, idex ) ! now salinity #if defined key_dynspg_rl CALL histwrite( id_i, "sobarstf", 1, bsfn , jpi*jpj , idex ) ! barotropic streamfunction #else CALL histwrite( id_i, "sossheig", 1, sshn , jpi*jpj , idex ) ! sea surface height #endif CALL histwrite( id_i, "vozocrtx", 1, un , jpi*jpj*jpk, idex ) ! now i-velocity CALL histwrite( id_i, "vomecrty", 1, vn , jpi*jpj*jpk, idex ) ! now j-velocity CALL histwrite( id_i, "vovecrtz", 1, wn , jpi*jpj*jpk, idex ) ! now k-velocity CALL histwrite( id_i, "sowaflup", 1, emp , jpi*jpj , idex ) ! freshwater budget CALL histwrite( id_i, "sohefldo", 1, qsr + qns, jpi*jpj , idex ) ! total heat flux CALL histwrite( id_i, "soshfldo", 1, qsr , jpi*jpj , idex ) ! solar heat flux CALL histwrite( id_i, "soicecov", 1, fr_i , jpi*jpj , idex ) ! ice fraction CALL histwrite( id_i, "sozotaux", 1, utau , jpi*jpj , idex ) ! i-wind stress CALL histwrite( id_i, "sometauy", 1, vtau , jpi*jpj , idex ) ! j-wind stress ! 3. Close the file ! ----------------- CALL histclo( id_i ) END SUBROUTINE dia_wri_state #endif !!====================================================================== END MODULE diawri