New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

diawri.F90 in NEMO/trunk/src/SAS – NEMO

Context Navigation

source: NEMO/trunk/src/SAS/diawri.F90 @ 12633

Last change on this file since 12633 was 12633, checked in by smasson, 4 years ago
trunk: compile SAS without key_iomput, see #2426
Property svn:keywords set to `Id`
File size: 24.3 KB

Rev	Line
[3331]	1	MODULE diawri
	2	!!======================================================================
	3	!! * MODULE diawri *
	4	!! Ocean diagnostics : write ocean output files
	5	!!=====================================================================
	6	!! History : OPA ! 1991-03 (M.-A. Foujols) Original code
	7	!! 4.0 ! 1991-11 (G. Madec)
	8	!! ! 1992-06 (M. Imbard) correction restart file
	9	!! ! 1992-07 (M. Imbard) split into diawri and rstwri
	10	!! ! 1993-03 (M. Imbard) suppress writibm
	11	!! ! 1998-01 (C. Levy) NETCDF format using ioipsl INTERFACE
	12	!! ! 1999-02 (E. Guilyardi) name of netCDF files + variables
	13	!! 8.2 ! 2000-06 (M. Imbard) Original code (diabort.F)
	14	!! NEMO 1.0 ! 2002-06 (A.Bozec, E. Durand) Original code (diainit.F)
	15	!! - ! 2002-09 (G. Madec) F90: Free form and module
	16	!! - ! 2002-12 (G. Madec) merge of diabort and diainit, F90
	17	!! ! 2005-11 (V. Garnier) Surface pressure gradient organization
	18	!! 3.2 ! 2008-11 (B. Lemaire) creation from old diawri
	19	!!----------------------------------------------------------------------
	20
	21	!!----------------------------------------------------------------------
	22	!! dia_wri : create the standart output files
	23	!! dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
	24	!!----------------------------------------------------------------------
	25	USE oce ! ocean dynamics and tracers
[12377]	26	USE abl ! abl variables in case ln_abl = .true.
[3331]	27	USE dom_oce ! ocean space and time domain
	28	USE zdf_oce ! ocean vertical physics
	29	USE sbc_oce ! Surface boundary condition: ocean fields
	30	USE sbc_ice ! Surface boundary condition: ice fields
	31	USE sbcssr ! restoring term toward SST/SSS climatology
	32	USE phycst ! physical constants
	33	USE zdfmxl ! mixed layer
	34	USE dianam ! build name of file (routine)
	35	USE zdfddm ! vertical physics: double diffusion
	36	USE diahth ! thermocline diagnostics
	37	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	38	USE in_out_manager ! I/O manager
	39	USE iom
	40	USE ioipsl
[9570]	41	#if defined key_si3
[10425]	42	USE ice
[9019]	43	USE icewri
[3331]	44	#endif
	45	USE lib_mpp ! MPP library
	46	USE timing ! preformance summary
	47
	48	IMPLICIT NONE
	49	PRIVATE
	50
	51	PUBLIC dia_wri ! routines called by step.F90
	52	PUBLIC dia_wri_state
	53	PUBLIC dia_wri_alloc ! Called by nemogcm module
[12377]	54	#if ! defined key_iomput
	55	PUBLIC dia_wri_alloc_abl ! Called by sbcabl module (if ln_abl = .true.)
	56	#endif
[3331]	57	INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file
	58	INTEGER :: nid_U, nz_U, nh_U, ndim_U, ndim_hU ! grid_U file
	59	INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file
[12377]	60	INTEGER :: ndim_A, ndim_hA ! ABL file
	61	INTEGER :: nid_A, nz_A, nh_A ! grid_ABL file
[3331]	62	INTEGER :: ndex(1) ! ???
	63	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV
[12377]	64	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL
[3331]	65
	66	!!----------------------------------------------------------------------
[10068]	67	!! NEMO/SAS 4.0 , NEMO Consortium (2018)
[5217]	68	!! $Id$
[10068]	69	!! Software governed by the CeCILL license (see ./LICENSE)
[3331]	70	!!----------------------------------------------------------------------
	71	CONTAINS
	72
[7761]	73	# if defined key_iomput
[3331]	74	!!----------------------------------------------------------------------
	75	!! 'key_iomput' use IOM library
	76	!!----------------------------------------------------------------------
[9652]	77	INTEGER FUNCTION dia_wri_alloc()
	78	!
	79	dia_wri_alloc = 0
	80	!
	81	END FUNCTION dia_wri_alloc
[3331]	82
[9652]	83
[12377]	84	SUBROUTINE dia_wri( kt, Kmm )
[3331]	85	!!---------------------------------------------------------------------
	86	!! * ROUTINE dia_wri *
	87	!!
	88	!! ** Purpose : Standard output of opa: dynamics and tracer fields
	89	!! NETCDF format is used by default
	90	!! Standalone surface scheme
	91	!!
	92	!! ** Method : use iom_put
	93	!!----------------------------------------------------------------------
[7761]	94	!!
	95	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[12377]	96	INTEGER, INTENT( in ) :: Kmm ! ocean time levelindex
[3331]	97	!!----------------------------------------------------------------------
	98	!
[7761]	99	! Output the initial state and forcings
	100	IF( ninist == 1 ) THEN
[12633]	101	CALL dia_wri_state( Kmm, 'output.init' )
[7761]	102	ninist = 0
	103	ENDIF
[3331]	104	!
	105	END SUBROUTINE dia_wri
	106
	107	#else
	108	!!----------------------------------------------------------------------
	109	!! Default option use IOIPSL library
	110	!!----------------------------------------------------------------------
[9652]	111	INTEGER FUNCTION dia_wri_alloc()
	112	!!----------------------------------------------------------------------
	113	INTEGER :: ierr
	114	!!----------------------------------------------------------------------
	115	!
	116	ALLOCATE( ndex_hT(jpijpj), ndex_hU(jpijpj), ndex_hV(jpi*jpj), STAT=dia_wri_alloc )
[10425]	117	CALL mpp_sum( 'diawri', dia_wri_alloc )
[9652]	118	!
	119	END FUNCTION dia_wri_alloc
	120
[12377]	121	INTEGER FUNCTION dia_wri_alloc_abl()
	122	!!----------------------------------------------------------------------
	123	ALLOCATE( ndex_hA(jpijpj), ndex_A (jpijpj*jpkam1), STAT=dia_wri_alloc_abl)
	124	CALL mpp_sum( 'diawri', dia_wri_alloc_abl )
	125	!
	126	END FUNCTION dia_wri_alloc_abl
[9652]	127
[12633]	128	SUBROUTINE dia_wri( kt, Kmm )
[3331]	129	!!---------------------------------------------------------------------
	130	!! * ROUTINE dia_wri *
	131	!!
	132	!! ** Purpose : Standard output of opa: dynamics and tracer fields
	133	!! NETCDF format is used by default
	134	!!
	135	!! ** Method : At the beginning of the first time step (nit000),
	136	!! define all the NETCDF files and fields
	137	!! At each time step call histdef to compute the mean if ncessary
[11536]	138	!! Each nn_write time step, output the instantaneous or mean fields
[3331]	139	!!----------------------------------------------------------------------
	140	!!
	141	INTEGER, INTENT( in ) :: kt ! ocean time-step index
[12633]	142	INTEGER, INTENT( in ) :: Kmm ! ocean time level index
[3331]	143	!!
	144	LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
	145	CHARACTER (len=40) :: clhstnam, clop, clmx ! local names
	146	INTEGER :: inum = 11 ! temporary logical unit
	147	INTEGER :: ji, jj, jk ! dummy loop indices
	148	INTEGER :: ierr ! error code return from allocation
	149	INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers
[12377]	150	INTEGER :: ipka ! ABL
[6140]	151	REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars
[12377]	152	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace
[3331]	153	!!----------------------------------------------------------------------
	154	!
	155	! Output the initial state and forcings
	156	IF( ninist == 1 ) THEN
[12633]	157	CALL dia_wri_state( Kmm, 'output.init' )
[3331]	158	ninist = 0
	159	ENDIF
	160	!
[11536]	161	IF( nn_write == -1 ) RETURN ! we will never do any output
	162	!
	163	IF( ln_timing ) CALL timing_start('dia_wri')
	164	!
[3331]	165	! 0. Initialisation
	166	! -----------------
	167
	168	! local variable for debugging
	169	ll_print = .FALSE.
	170	ll_print = ll_print .AND. lwp
	171
	172	! Define frequency of output and means
	173	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
	174	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
	175	ENDIF
	176	#if defined key_diainstant
[12489]	177	zsto = nn_write * rn_Dt
[3331]	178	clop = "inst("//TRIM(clop)//")"
	179	#else
[12489]	180	zsto=rn_Dt
[3331]	181	clop = "ave("//TRIM(clop)//")"
	182	#endif
[12489]	183	zout = nn_write * rn_Dt
	184	zmax = ( nitend - nit000 + 1 ) * rn_Dt
[3331]	185
	186	! Define indices of the horizontal output zoom and vertical limit storage
	187	iimi = 1 ; iima = jpi
	188	ijmi = 1 ; ijma = jpj
	189	ipk = jpk
[12377]	190	IF(ln_abl) ipka = jpkam1
[3331]	191
	192	! define time axis
	193	it = kt
	194	itmod = kt - nit000 + 1
	195
	196
	197	! 1. Define NETCDF files and fields at beginning of first time step
	198	! -----------------------------------------------------------------
	199
	200	IF( kt == nit000 ) THEN
	201
	202	! Define the NETCDF files (one per grid)
	203
	204	! Compute julian date from starting date of the run
[12489]	205	CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian )
[3331]	206	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
	207	IF(lwp)WRITE(numout,*)
	208	IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear, &
	209	& ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
	210	IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &
	211	' limit storage in depth = ', ipk
	212
	213	! WRITE root name in date.file for use by postpro
	214	IF(lwp) THEN
[11536]	215	CALL dia_nam( clhstnam, nn_write,' ' )
[3331]	216	CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
	217	WRITE(inum,*) clhstnam
	218	CLOSE(inum)
	219	ENDIF
	220
	221	! Define the T grid FILE ( nid_T )
	222
[11536]	223	CALL dia_nam( clhstnam, nn_write, 'grid_T' )
[3331]	224	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
	225	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
	226	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
[12489]	227	& nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
[3331]	228	CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept
[4292]	229	& "m", ipk, gdept_1d, nz_T, "down" )
[3331]	230	! ! Index of ocean points
	231	CALL wheneq( jpi*jpj , tmask, 1, 1., ndex_hT, ndim_hT ) ! surface
	232
	233	! Define the U grid FILE ( nid_U )
	234
[11536]	235	CALL dia_nam( clhstnam, nn_write, 'grid_U' )
[3331]	236	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
	237	CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu
	238	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
[12489]	239	& nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
[3331]	240	CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept
[4292]	241	& "m", ipk, gdept_1d, nz_U, "down" )
[3331]	242	! ! Index of ocean points
	243	CALL wheneq( jpi*jpj , umask, 1, 1., ndex_hU, ndim_hU ) ! surface
	244
	245	! Define the V grid FILE ( nid_V )
	246
[11536]	247	CALL dia_nam( clhstnam, nn_write, 'grid_V' ) ! filename
[3331]	248	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
	249	CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv
	250	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
[12489]	251	& nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
[3331]	252	CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept
[4292]	253	& "m", ipk, gdept_1d, nz_V, "down" )
[3331]	254	! ! Index of ocean points
	255	CALL wheneq( jpi*jpj , vmask, 1, 1., ndex_hV, ndim_hV ) ! surface
	256
	257	! No W grid FILE
[12377]	258	IF( ln_abl ) THEN
	259	! Define the ABL grid FILE ( nid_A )
[12633]	260	CALL dia_nam( clhstnam, nn_write, 'grid_ABL' )
[12377]	261	IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename
	262	CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit
	263	& iimi, iima-iimi+1, ijmi, ijma-ijmi+1, &
[12489]	264	& nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set )
[12377]	265	CALL histvert( nid_A, "ght_abl", "Vertical T levels", & ! Vertical grid: gdept
	266	& "m", ipka, ght_abl(2:jpka), nz_A, "up" )
	267	! ! Index of ocean points
	268	ALLOCATE( zw3d_abl(jpi,jpj,ipka) )
	269	zw3d_abl(:,:,:) = 1._wp
	270	CALL wheneq( jpijpjipka, zw3d_abl, 1, 1., ndex_A , ndim_A ) ! volume
	271	CALL wheneq( jpi*jpj , zw3d_abl, 1, 1., ndex_hA, ndim_hA ) ! surface
	272	DEALLOCATE(zw3d_abl)
	273	ENDIF
[3331]	274
	275	! Declare all the output fields as NETCDF variables
	276
	277	! !!! nid_T : 3D
	278	CALL histdef( nid_T, "sst_m", "Sea Surface temperature" , "C" , & ! sst
	279	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	280	CALL histdef( nid_T, "sss_m", "Sea Surface Salinity" , "PSU" , & ! sss
	281	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	282	CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! (emp-rnf)
	283	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
[4148]	284	CALL histdef( nid_T, "sosfldow", "downward salt flux" , "PSU/m2/s", & ! (sfx)
	285	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
[3331]	286	CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux" , "W/m2" , & ! qns + qsr
	287	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	288	CALL histdef( nid_T, "soshfldo", "Shortwave Radiation" , "W/m2" , & ! qsr
	289	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	290	CALL histdef( nid_T, "soicecov", "Ice fraction" , "[0,1]" , & ! fr_i
	291	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	292	CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm
	293	& jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
[12377]	294	!
	295	IF( ln_abl ) THEN
	296	! !!! nid_A : 3D
	297	CALL histdef( nid_A, "t_abl", "Potential Temperature" , "K" , & ! t_abl
	298	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	299	CALL histdef( nid_A, "q_abl", "Humidity" , "kg/kg" , & ! q_abl
	300	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	301	CALL histdef( nid_A, "u_abl", "Atmospheric U-wind " , "m/s" , & ! u_abl
	302	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	303	CALL histdef( nid_A, "v_abl", "Atmospheric V-wind " , "m/s" , & ! v_abl
	304	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	305	CALL histdef( nid_A, "tke_abl", "Atmospheric TKE " , "m2/s2" , & ! tke_abl
	306	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	307	CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s" , & ! avm_abl
	308	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	309	CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2", & ! avt_abl
	310	& jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )
	311	CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height " , "m", & ! pblh
	312	& jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	313	#if defined key_si3
	314	CALL histdef( nid_A, "oce_frac", "Fraction of open ocean" , " ", & ! ato_i
	315	& jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout )
	316	#endif
	317	CALL histend( nid_A, snc4chunks=snc4set )
	318	!
	319	ENDIF
	320	!
[3331]	321
	322	CALL histend( nid_T, snc4chunks=snc4set )
	323
	324	! !!! nid_U : 3D
	325	CALL histdef( nid_U, "ssu_m", "Velocity component in x-direction", "m/s" , & ! ssu
	326	& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
	327	CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau
	328	& jpi, jpj, nh_U, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
	329
	330	CALL histend( nid_U, snc4chunks=snc4set )
	331
	332	! !!! nid_V : 3D
	333	CALL histdef( nid_V, "ssv_m", "Velocity component in y-direction", "m/s", & ! ssv_m
	334	& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
	335	CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau
	336	& jpi, jpj, nh_V, 1 , 1, 1 , - 99, 32, clop, zsto, zout )
	337
	338	CALL histend( nid_V, snc4chunks=snc4set )
	339
	340	IF(lwp) WRITE(numout,*)
	341	IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
	342	IF(ll_print) CALL FLUSH(numout )
	343
	344	ENDIF
	345
	346	! 2. Start writing data
	347	! ---------------------
	348
	349	! ndex(1) est utilise ssi l'avant dernier argument est diffferent de
	350	! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
	351	! donne le nombre d'elements, et ndex la liste des indices a sortir
	352
[11536]	353	IF( lwp .AND. MOD( itmod, nn_write ) == 0 ) THEN
[3331]	354	WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
	355	WRITE(numout,*) '~~~~~~ '
	356	ENDIF
	357
	358	! Write fields on T grid
	359	CALL histwrite( nid_T, "sst_m", it, sst_m, ndim_hT, ndex_hT ) ! sea surface temperature
	360	CALL histwrite( nid_T, "sss_m", it, sss_m, ndim_hT, ndex_hT ) ! sea surface salinity
[4148]	361	CALL histwrite( nid_T, "sowaflup", it, (emp - rnf ) , ndim_hT, ndex_hT ) ! upward water flux
	362	CALL histwrite( nid_T, "sosfldow", it, sfx , ndim_hT, ndex_hT ) ! downward salt flux
	363	! (includes virtual salt flux beneath ice
	364	! in linear free surface case)
	365
[3331]	366	CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux
	367	CALL histwrite( nid_T, "soshfldo", it, qsr , ndim_hT, ndex_hT ) ! solar heat flux
	368	CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction
	369	CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed
[12377]	370	!
	371	IF( ln_abl ) THEN
	372	ALLOCATE( zw3d_abl(jpi,jpj,jpka) )
	373	IF( ln_mskland ) THEN
	374	DO jk=1,jpka
	375	zw3d_abl(:,:,jk) = tmask(:,:,1)
	376	END DO
	377	ELSE
	378	zw3d_abl(:,:,:) = 1._wp
	379	ENDIF
	380	CALL histwrite( nid_A, "pblh" , it, pblh(:,:) *zw3d_abl(:,:,1 ), ndim_hA, ndex_hA ) ! pblh
	381	CALL histwrite( nid_A, "u_abl" , it, u_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! u_abl
	382	CALL histwrite( nid_A, "v_abl" , it, v_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! v_abl
	383	CALL histwrite( nid_A, "t_abl" , it, tq_abl (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! t_abl
	384	CALL histwrite( nid_A, "q_abl" , it, tq_abl (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! q_abl
	385	CALL histwrite( nid_A, "tke_abl", it, tke_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! tke_abl
	386	CALL histwrite( nid_A, "avm_abl", it, avm_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avm_abl
	387	CALL histwrite( nid_A, "avt_abl", it, avt_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avt_abl
	388	#if defined key_si3
	389	CALL histwrite( nid_A, "oce_frac" , it, ato_i(:,:) , ndim_hA, ndex_hA ) ! ato_i
	390	#endif
	391	DEALLOCATE(zw3d_abl)
	392	ENDIF
	393	!
[3331]	394
	395	! Write fields on U grid
	396	CALL histwrite( nid_U, "ssu_m" , it, ssu_m , ndim_hU, ndex_hU ) ! i-current speed
	397	CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress
	398
	399	! Write fields on V grid
	400	CALL histwrite( nid_V, "ssv_m" , it, ssv_m , ndim_hV, ndex_hV ) ! j-current speed
	401	CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress
	402
	403	! 3. Close all files
	404	! ---------------------------------------
	405	IF( kt == nitend ) THEN
	406	CALL histclo( nid_T )
	407	CALL histclo( nid_U )
	408	CALL histclo( nid_V )
[12377]	409	IF(ln_abl) CALL histclo( nid_A )
[3331]	410	ENDIF
	411	!
[9124]	412	IF( ln_timing ) CALL timing_stop('dia_wri')
[3331]	413	!
	414	END SUBROUTINE dia_wri
	415	#endif
	416
[12633]	417	SUBROUTINE dia_wri_state( Kmm, cdfile_name )
[3331]	418	!!---------------------------------------------------------------------
	419	!! * ROUTINE dia_wri_state *
	420	!!
	421	!! ** Purpose : create a NetCDF file named cdfile_name which contains
	422	!! the instantaneous ocean state and forcing fields.
	423	!! Used to find errors in the initial state or save the last
	424	!! ocean state in case of abnormal end of a simulation
	425	!!
	426	!! ** Method : NetCDF files using ioipsl
	427	!! File 'output.init.nc' is created if ninist = 1 (namelist)
	428	!! File 'output.abort.nc' is created in case of abnormal job end
	429	!!----------------------------------------------------------------------
[12633]	430	INTEGER , INTENT( in ) :: Kmm ! ocean time levelindex
[3331]	431	CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created
[10425]	432	!!
	433	INTEGER :: inum
[3331]	434	!!----------------------------------------------------------------------
	435	!
	436	IF(lwp) WRITE(numout,*)
	437	IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
	438	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created '
[10425]	439	IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc'
[3331]	440
[9570]	441	#if defined key_si3
[10425]	442	CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
[3331]	443	#else
[10425]	444	CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. )
[3331]	445	#endif
	446
[12377]	447	CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) ) ! now temperature
	448	CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) ) ! now salinity
	449	CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:, Kmm) ) ! sea surface height
	450	CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu (:,:,:, Kmm) ) ! now i-velocity
	451	CALL iom_rstput( 0, 0, inum, 'vomecrty', vv (:,:,:, Kmm) ) ! now j-velocity
	452	CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity
	453	CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget
	454	CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux
	455	CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr ) ! solar heat flux
	456	CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i ) ! ice fraction
	457	CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress
	458	CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress
[10425]	459
	460	#if defined key_si3
	461	IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid
	462	CALL ice_wri_state( inum )
[3331]	463	ENDIF
	464	#endif
[9124]	465	!
[10425]	466	CALL iom_close( inum )
[9124]	467	!
	468	END SUBROUTINE dia_wri_state
[3331]	469
	470	!!======================================================================
	471	END MODULE diawri

Note: See TracBrowser for help on using the repository browser.

Download in other formats: