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_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/FLO – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/FLO/flowri.F90 @ 10970

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

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

Download in other formats: