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/2020/r12377_ticket2386/src/OCE/FLO – NEMO

Context Navigation

source: NEMO/branches/2020/r12377_ticket2386/src/OCE/FLO/flowri.F90 @ 12511

Last change on this file since 12511 was 12511, checked in by andmirek, 4 years ago
ticket #2386: update trunk@12493 to have AGRIF sette working
Property svn:keywords set to `Id`
File size: 11.9 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
[12377]	53	SUBROUTINE flo_wri( kt, Kmm )
[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
[12377]	66	INTEGER, INTENT(in) :: kt ! time step
	67	INTEGER, INTENT(in) :: Kmm ! time level index
[3]	68
[3294]	69	!! * Local declarations
	70	INTEGER :: iafl , ibfl , icfl ! temporary integer
	71	INTEGER :: ia1fl, ib1fl, ic1fl ! "
	72	INTEGER :: iafloc,ibfloc,ia1floc,ib1floc ! "
	73	INTEGER :: irec, irecflo
	74
	75	REAL(wp) :: zafl,zbfl,zcfl ! temporary real
	76	REAL(wp) :: ztime ! "
	77
	78	INTEGER, DIMENSION(2) :: icount
	79	INTEGER, DIMENSION(2) :: istart
	80	INTEGER, DIMENSION(1) :: ish
	81	INTEGER, DIMENSION(2) :: ish2
	82	!!----------------------------------------------------------------------
[3]	83
[3294]	84	!-----------------------------------------------------
	85	! I- Save positions, temperature, salinty and density
	86	!-----------------------------------------------------
	87	zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0
	88	ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0
[3]	89
[3294]	90	DO jfl = 1, jpnfl
[3]	91
[3294]	92	iafl = INT (tpifl(jfl)) ! I-index of the nearest point before
	93	ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before
	94	icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before
	95	ia1fl = iafl + 1 ! I-index of the nearest point after
	96	ib1fl = ibfl + 1 ! J-index of the nearest point after
	97	ic1fl = icfl + 1 ! K-index of the nearest point after
	98	zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ?????
	99	zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ?????
	100	zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ?????
[3]	101
[16]	102	IF( lk_mpp ) THEN
[3294]	103
	104	iafloc = mi1( iafl )
	105	ibfloc = mj1( ibfl )
	106
	107	IF( nldi <= iafloc .AND. iafloc <= nlei .AND. &
	108	& nldj <= ibfloc .AND. ibfloc <= nlej ) THEN
[3]	109
[3294]	110	!the float is inside of current proc's area
	111	ia1floc = iafloc + 1
	112	ib1floc = ibfloc + 1
	113
	114	!save position of the float
	115	zlat(jfl) = (1.-zafl)(1.-zbfl)gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) &
	116	+ zafl (1.-zbfl)gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)
	117	zlon(jfl) = (1.-zafl)(1.-zbfl)glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) &
	118	+ zafl (1.-zbfl)glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc)
[12377]	119	zdep(jfl) = (1.-zcfl)gdepw(iafloc,ibfloc,icfl ,Kmm) + zcfl gdepw(iafloc,ibfloc,ic1fl,Kmm)
[3]	120
[3294]	121	!save temperature, salinity and density at this position
[12377]	122	ztem(jfl) = ts(iafloc,ibfloc,icfl,jp_tem,Kmm)
	123	zsal (jfl) = ts(iafloc,ibfloc,icfl,jp_sal,Kmm)
[12511]	124	zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0
[16]	125
[3294]	126	ENDIF
[16]	127
[3294]	128	ELSE ! mono proc case
[16]	129
[3294]	130	iafloc = iafl
	131	ibfloc = ibfl
	132	ia1floc = iafloc + 1
	133	ib1floc = ibfloc + 1
[16]	134
[3294]	135	!save position of the float
	136	zlat(jfl) = (1.-zafl)(1.-zbfl)gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) &
	137	+ zafl (1.-zbfl)gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)
	138	zlon(jfl) = (1.-zafl)(1.-zbfl)glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) &
	139	+ zafl (1.-zbfl)glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc)
[12377]	140	zdep(jfl) = (1.-zcfl)gdepw(iafloc,ibfloc,icfl ,Kmm) + zcfl gdepw(iafloc,ibfloc,ic1fl,Kmm)
[3]	141
[12377]	142	ztem(jfl) = ts(iafloc,ibfloc,icfl,jp_tem,Kmm)
	143	zsal(jfl) = ts(iafloc,ibfloc,icfl,jp_sal,Kmm)
[12511]	144	zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rho0
[3294]	145
[16]	146	ENDIF
[3]	147
[3294]	148	END DO ! loop on float
	149
	150	!Only proc 0 writes all positions : SUM of positions on all procs
	151	IF( lk_mpp ) THEN
[10425]	152	CALL mpp_sum( 'flowri', zlon, jpnfl ) ! sums over the global domain
	153	CALL mpp_sum( 'flowri', zlat, jpnfl ) ! sums over the global domain
	154	CALL mpp_sum( 'flowri', zdep, jpnfl ) ! sums over the global domain
	155	CALL mpp_sum( 'flowri', ztem, jpnfl ) ! sums over the global domain
	156	CALL mpp_sum( 'flowri', zsal, jpnfl ) ! sums over the global domain
	157	CALL mpp_sum( 'flowri', zrho, jpnfl ) ! sums over the global domain
[3]	158	ENDIF
[3294]	159
	160
	161	!-------------------------------------!
	162	! II- WRITE WRITE WRITE WRITE WRITE !
	163	!-------------------------------------!
	164
	165	!--------------------------!
	166	! II-1 Write in ascii file !
	167	!--------------------------!
	168
	169	IF( ln_flo_ascii )THEN
	170
	171	IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
	172
	173	!II-1-a Open ascii file
	174	!----------------------
	175	IF( kt == nn_it000 ) THEN
	176	CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
	177	irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) )
[11536]	178	WRITE(numflo,*) cexper, irecflo, jpnfl, nn_writefl
[3294]	179	ENDIF
	180
	181	!II-1-b Write in ascii file
	182	!-----------------------------
	183	WRITE(numflo,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)
	184
	185
	186	!II-1-c Close netcdf file
	187	!-------------------------
	188	IF( kt == nitend ) CLOSE( numflo )
	189
[3]	190	ENDIF
	191
[3294]	192	!-----------------------------------------------------
	193	! II-2 Write in netcdf file
	194	!-----------------------------------------------------
[3]	195
[3294]	196	ELSE
[3]	197
[3294]	198	!II-2-a Write with IOM
	199	!----------------------
	200
	201	#if defined key_iomput
	202	CALL iom_put( "traj_lon" , zlon )
	203	CALL iom_put( "traj_lat" , zlat )
	204	CALL iom_put( "traj_dep" , zdep )
	205	CALL iom_put( "traj_temp" , ztem )
	206	CALL iom_put( "traj_salt" , zsal )
	207	CALL iom_put( "traj_dens" , zrho )
	208	CALL iom_put( "traj_group" , REAL(ngrpfl,wp) )
	209	#else
	210
	211	!II-2-b Write with IOIPSL
	212	!------------------------
	213
	214	IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
	215
	216
	217	!II-2-b-1 Open netcdf file
	218	!-------------------------
	219	IF( kt==nn_it000 )THEN ! Create and open
	220
	221	CALL dia_nam( clname, nn_writefl, 'trajec_float' )
	222	clname=TRIM(clname)//".nc"
	223
[11818]	224	CALL fliocrfd( clname , (/'ntraj' , ' t' /), (/ jpnfl , -1/) , numflo )
[3294]	225
	226	CALL fliodefv( numflo, 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" )
	227	CALL fliodefv( numflo, 'traj_lat' , (/1,2/), v_t=flio_r8, long_name="Latitude" , units="degrees_north" )
	228	CALL fliodefv( numflo, 'traj_depth' , (/1,2/), v_t=flio_r8, long_name="Depth" , units="meters" )
	229	CALL fliodefv( numflo, 'time_counter', (/2/) , v_t=flio_r8, long_name="Time axis" &
	230	& , units="seconds since start of the run " )
	231	CALL fliodefv( numflo, 'traj_temp' , (/1,2/), v_t=flio_r8, long_name="Temperature" , units="C" )
	232	CALL fliodefv( numflo, 'traj_salt' , (/1,2/), v_t=flio_r8, long_name="Salinity" , units="PSU" )
	233	CALL fliodefv( numflo, 'traj_dens' , (/1,2/), v_t=flio_r8, long_name="Density" , units="kg/m3" )
	234	CALL fliodefv( numflo, 'traj_group' , (/1/) , v_t=flio_r8, long_name="number of the group" , units="no unit" )
	235
	236	CALL flioputv( numflo , 'traj_group' , REAL(ngrpfl,wp) )
	237
	238	ELSE ! Re-open
	239
	240	CALL flioopfd( TRIM(clname), numflo , "WRITE" )
	241
	242	ENDIF
	243
	244	!II-2-b-2 Write in netcdf file
	245	!-------------------------------
	246	irec = INT( (kt-nn_it000+1)/nn_writefl ) +1
[12511]	247	ztime = ( kt-nn_it000 + 1 ) * rn_Dt
[3294]	248
	249	CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) )
	250
[16]	251	DO jfl = 1, jpnfl
[3294]	252
	253	istart = (/jfl,irec/)
	254
[11536]	255	CALL flioputv( numflo , 'traj_lon' , zlon(jfl), start=istart )
	256	CALL flioputv( numflo , 'traj_lat' , zlat(jfl), start=istart )
	257	CALL flioputv( numflo , 'traj_depth' , zdep(jfl), start=istart )
	258	CALL flioputv( numflo , 'traj_temp' , ztem(jfl), start=istart )
	259	CALL flioputv( numflo , 'traj_salt' , zsal(jfl), start=istart )
	260	CALL flioputv( numflo , 'traj_dens' , zrho(jfl), start=istart )
[3294]	261
	262	ENDDO
	263
	264	!II-2-b-3 Close netcdf file
	265	!---------------------------
	266	CALL flioclo( numflo )
	267
[3]	268	ENDIF
	269
[3294]	270	#endif
	271	ENDIF ! netcdf writing
	272
[3]	273	END SUBROUTINE flo_wri
	274
[3294]	275	!!=======================================================================
[3]	276	END MODULE flowri

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

Download in other formats: