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.

flowri.F90 in NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/FLO – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/FLO/flowri.F90 @ 11954

Last change on this file since 11954 was 11954, checked in by acc, 4 years ago
Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Merge in trunk changes up to 11943 in preparation for end of year merge
Property svn:keywords set to `Id`
File size: 11.8 KB

Rev	Line
[3]	1	MODULE flowri
	2	!!======================================================================
	3	!! * MODULE flowri *
[3294]	4	!!
[5836]	5	!! Ocean floats: write floats trajectory in ascii ln_flo_ascii = T
	6	!! or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F
[3]	7	!!======================================================================
[5836]	8	!! History : OPA ! 1999-09 (Y. Drillet) : Original code
	9	!! - ! 2000-06 (J.-M. Molines) : Profiling floats for CLS
	10	!! NEMO 1.0 ! 2002-10 (A. Bozec) F90 : Free form and module
	11	!! 3.2 ! 2010-08 (slaw, cbricaud): netcdf outputs and others
[1601]	12	!!----------------------------------------------------------------------
[3]	13	USE flo_oce ! ocean drifting floats
	14	USE oce ! ocean dynamics and tracers
	15	USE dom_oce ! ocean space and time domain
	16	USE lib_mpp ! distribued memory computing library
	17	USE in_out_manager ! I/O manager
[3294]	18	USE phycst ! physic constants
	19	USE dianam ! build name of file (routine)
	20	USE ioipsl
	21	USE iom ! I/O library
[3]	22
	23	IMPLICIT NONE
	24	PRIVATE
	25
[3294]	26	PUBLIC flo_wri ! routine called by floats.F90
	27	PUBLIC flo_wri_alloc ! routine called by floats.F90
[3]	28
[3294]	29	INTEGER :: jfl ! number of floats
	30	CHARACTER (len=80) :: clname ! netcdf output filename
[1601]	31
[3294]	32	REAL(wp), ALLOCATABLE, DIMENSION(:) :: zlon , zlat, zdep ! 2D workspace
	33	REAL(wp), ALLOCATABLE, DIMENSION(:) :: ztem , zsal, zrho ! 2D workspace
[2715]	34
[3]	35	!!----------------------------------------------------------------------
[9598]	36	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5217]	37	!! $Id$
[10068]	38	!! Software governed by the CeCILL license (see ./LICENSE)
[3]	39	!!----------------------------------------------------------------------
	40	CONTAINS
	41
[3294]	42	INTEGER FUNCTION flo_wri_alloc()
[2715]	43	!!-------------------------------------------------------------------
	44	!! * FUNCTION flo_wri_alloc *
	45	!!-------------------------------------------------------------------
[3294]	46	ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , &
	47	zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc)
	48	!
[10425]	49	CALL mpp_sum ( 'flowri', flo_wri_alloc )
	50	IF( flo_wri_alloc /= 0 ) CALL ctl_stop( 'STOP', 'flo_wri_alloc: failed to allocate arrays.' )
[2715]	51	END FUNCTION flo_wri_alloc
	52
[3]	53	SUBROUTINE flo_wri( kt )
[3294]	54	!!---------------------------------------------------------------------
	55	!! * ROUTINE flo_wri *
[3]	56	!!
[3294]	57	!! ** Purpose : Write position of floats in "trajec_float.nc",according
	58	!! to ARIANE TOOLS (http://stockage.univ-brest.fr/~grima/Ariane/ ) n
	59	!! nomenclature
	60	!!
[3]	61	!!
[3294]	62	!! ** Method : The frequency of ??? is nwritefl
	63	!!
[3]	64	!!----------------------------------------------------------------------
[3294]	65	!! * Arguments
	66	INTEGER :: kt ! time step
[3]	67
[3294]	68	!! * Local declarations
	69	INTEGER :: iafl , ibfl , icfl ! temporary integer
	70	INTEGER :: ia1fl, ib1fl, ic1fl ! "
	71	INTEGER :: iafloc,ibfloc,ia1floc,ib1floc ! "
	72	INTEGER :: irec, irecflo
	73
	74	REAL(wp) :: zafl,zbfl,zcfl ! temporary real
	75	REAL(wp) :: ztime ! "
	76
	77	INTEGER, DIMENSION(2) :: icount
	78	INTEGER, DIMENSION(2) :: istart
	79	INTEGER, DIMENSION(1) :: ish
	80	INTEGER, DIMENSION(2) :: ish2
	81	!!----------------------------------------------------------------------
[3]	82
[3294]	83	!-----------------------------------------------------
	84	! I- Save positions, temperature, salinty and density
	85	!-----------------------------------------------------
	86	zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0
	87	ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0
[3]	88
[3294]	89	DO jfl = 1, jpnfl
[3]	90
[3294]	91	iafl = INT (tpifl(jfl)) ! I-index of the nearest point before
	92	ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before
	93	icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before
	94	ia1fl = iafl + 1 ! I-index of the nearest point after
	95	ib1fl = ibfl + 1 ! J-index of the nearest point after
	96	ic1fl = icfl + 1 ! K-index of the nearest point after
	97	zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ?????
	98	zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ?????
	99	zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ?????
[3]	100
[16]	101	IF( lk_mpp ) THEN
[3294]	102
	103	iafloc = mi1( iafl )
	104	ibfloc = mj1( ibfl )
	105
	106	IF( nldi <= iafloc .AND. iafloc <= nlei .AND. &
	107	& nldj <= ibfloc .AND. ibfloc <= nlej ) THEN
[3]	108
[3294]	109	!the float is inside of current proc's area
	110	ia1floc = iafloc + 1
	111	ib1floc = ibfloc + 1
	112
	113	!save position of the float
	114	zlat(jfl) = (1.-zafl)(1.-zbfl)gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) &
	115	+ zafl (1.-zbfl)gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)
	116	zlon(jfl) = (1.-zafl)(1.-zbfl)glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) &
	117	+ zafl (1.-zbfl)glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc)
[6140]	118	zdep(jfl) = (1.-zcfl)gdepw_n(iafloc,ibfloc,icfl ) + zcfl gdepw_n(iafloc,ibfloc,ic1fl)
[3]	119
[3294]	120	!save temperature, salinity and density at this position
	121	ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
	122	zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal)
	123	zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
[16]	124
[3294]	125	ENDIF
[16]	126
[3294]	127	ELSE ! mono proc case
[16]	128
[3294]	129	iafloc = iafl
	130	ibfloc = ibfl
	131	ia1floc = iafloc + 1
	132	ib1floc = ibfloc + 1
[16]	133
[3294]	134	!save position of the float
	135	zlat(jfl) = (1.-zafl)(1.-zbfl)gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) &
	136	+ zafl (1.-zbfl)gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)
	137	zlon(jfl) = (1.-zafl)(1.-zbfl)glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) &
	138	+ zafl (1.-zbfl)glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc)
[6140]	139	zdep(jfl) = (1.-zcfl)gdepw_n(iafloc,ibfloc,icfl ) + zcfl gdepw_n(iafloc,ibfloc,ic1fl)
[3]	140
[3294]	141	ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem)
	142	zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal)
	143	zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
	144
[16]	145	ENDIF
[3]	146
[3294]	147	END DO ! loop on float
	148
	149	!Only proc 0 writes all positions : SUM of positions on all procs
	150	IF( lk_mpp ) THEN
[10425]	151	CALL mpp_sum( 'flowri', zlon, jpnfl ) ! sums over the global domain
	152	CALL mpp_sum( 'flowri', zlat, jpnfl ) ! sums over the global domain
	153	CALL mpp_sum( 'flowri', zdep, jpnfl ) ! sums over the global domain
	154	CALL mpp_sum( 'flowri', ztem, jpnfl ) ! sums over the global domain
	155	CALL mpp_sum( 'flowri', zsal, jpnfl ) ! sums over the global domain
	156	CALL mpp_sum( 'flowri', zrho, jpnfl ) ! sums over the global domain
[3]	157	ENDIF
[3294]	158
	159
	160	!-------------------------------------!
	161	! II- WRITE WRITE WRITE WRITE WRITE !
	162	!-------------------------------------!
	163
	164	!--------------------------!
	165	! II-1 Write in ascii file !
	166	!--------------------------!
	167
	168	IF( ln_flo_ascii )THEN
	169
	170	IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
	171
	172	!II-1-a Open ascii file
	173	!----------------------
	174	IF( kt == nn_it000 ) THEN
	175	CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
	176	irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) )
[11536]	177	WRITE(numflo,*) cexper, irecflo, jpnfl, nn_writefl
[3294]	178	ENDIF
	179
	180	!II-1-b Write in ascii file
	181	!-----------------------------
	182	WRITE(numflo,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)
	183
	184
	185	!II-1-c Close netcdf file
	186	!-------------------------
	187	IF( kt == nitend ) CLOSE( numflo )
	188
[3]	189	ENDIF
	190
[3294]	191	!-----------------------------------------------------
	192	! II-2 Write in netcdf file
	193	!-----------------------------------------------------
[3]	194
[3294]	195	ELSE
[3]	196
[3294]	197	!II-2-a Write with IOM
	198	!----------------------
	199
	200	#if defined key_iomput
	201	CALL iom_put( "traj_lon" , zlon )
	202	CALL iom_put( "traj_lat" , zlat )
	203	CALL iom_put( "traj_dep" , zdep )
	204	CALL iom_put( "traj_temp" , ztem )
	205	CALL iom_put( "traj_salt" , zsal )
	206	CALL iom_put( "traj_dens" , zrho )
	207	CALL iom_put( "traj_group" , REAL(ngrpfl,wp) )
	208	#else
	209
	210	!II-2-b Write with IOIPSL
	211	!------------------------
	212
	213	IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
	214
	215
	216	!II-2-b-1 Open netcdf file
	217	!-------------------------
	218	IF( kt==nn_it000 )THEN ! Create and open
	219
	220	CALL dia_nam( clname, nn_writefl, 'trajec_float' )
	221	clname=TRIM(clname)//".nc"
	222
[11954]	223	CALL fliocrfd( clname , (/'ntraj' , ' t' /), (/ jpnfl , -1/) , numflo )
[3294]	224
	225	CALL fliodefv( numflo, 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" )
	226	CALL fliodefv( numflo, 'traj_lat' , (/1,2/), v_t=flio_r8, long_name="Latitude" , units="degrees_north" )
	227	CALL fliodefv( numflo, 'traj_depth' , (/1,2/), v_t=flio_r8, long_name="Depth" , units="meters" )
	228	CALL fliodefv( numflo, 'time_counter', (/2/) , v_t=flio_r8, long_name="Time axis" &
	229	& , units="seconds since start of the run " )
	230	CALL fliodefv( numflo, 'traj_temp' , (/1,2/), v_t=flio_r8, long_name="Temperature" , units="C" )
	231	CALL fliodefv( numflo, 'traj_salt' , (/1,2/), v_t=flio_r8, long_name="Salinity" , units="PSU" )
	232	CALL fliodefv( numflo, 'traj_dens' , (/1,2/), v_t=flio_r8, long_name="Density" , units="kg/m3" )
	233	CALL fliodefv( numflo, 'traj_group' , (/1/) , v_t=flio_r8, long_name="number of the group" , units="no unit" )
	234
	235	CALL flioputv( numflo , 'traj_group' , REAL(ngrpfl,wp) )
	236
	237	ELSE ! Re-open
	238
	239	CALL flioopfd( TRIM(clname), numflo , "WRITE" )
	240
	241	ENDIF
	242
	243	!II-2-b-2 Write in netcdf file
	244	!-------------------------------
	245	irec = INT( (kt-nn_it000+1)/nn_writefl ) +1
	246	ztime = ( kt-nn_it000 + 1 ) * rdt
	247
	248	CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) )
	249
[16]	250	DO jfl = 1, jpnfl
[3294]	251
	252	istart = (/jfl,irec/)
	253
[11536]	254	CALL flioputv( numflo , 'traj_lon' , zlon(jfl), start=istart )
	255	CALL flioputv( numflo , 'traj_lat' , zlat(jfl), start=istart )
	256	CALL flioputv( numflo , 'traj_depth' , zdep(jfl), start=istart )
	257	CALL flioputv( numflo , 'traj_temp' , ztem(jfl), start=istart )
	258	CALL flioputv( numflo , 'traj_salt' , zsal(jfl), start=istart )
	259	CALL flioputv( numflo , 'traj_dens' , zrho(jfl), start=istart )
[3294]	260
	261	ENDDO
	262
	263	!II-2-b-3 Close netcdf file
	264	!---------------------------
	265	CALL flioclo( numflo )
	266
[3]	267	ENDIF
	268
[3294]	269	#endif
	270	ENDIF ! netcdf writing
	271
[3]	272	END SUBROUTINE flo_wri
	273
[3294]	274	!!=======================================================================
[3]	275	END MODULE flowri

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

Download in other formats: