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 branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO – NEMO

Context Navigation

source: branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 @ 2876

Last change on this file since 2876 was 2876, checked in by cbricaud, 13 years ago
modify comments
Property svn:keywords set to `Id`
File size: 12.9 KB

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

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

Download in other formats: