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 @ 2839

Last change on this file since 2839 was 2839, checked in by cbricaud, 13 years ago
modified routine for netcdf output
Property svn:keywords set to `Id`
File size: 13.7 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
	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
[2715]	54	INTEGER FUNCTION flo_wri_alloc
	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
[2839]	98	!IF( MOD( kt,nn_writefl)== 0 ) THEN
[3]	99
	100
[2839]	101	!-----------------------------------------------------
	102	! I- Save positions, temperature, salinty and density
	103	!-----------------------------------------------------
	104	zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0
	105	ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0
[3]	106
[2839]	107	DO jfl = 1, jpnfl
[3]	108
[2839]	109	iafl = INT (tpifl(jfl)) ! I-index of the nearest point before
	110	ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before
	111	icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before
	112	ia1fl = iafl + 1 ! I-index of the nearest point after
	113	ib1fl = ibfl + 1 ! J-index of the nearest point after
	114	ic1fl = icfl + 1 ! K-index of the nearest point after
	115	zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ?????
	116	zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ?????
	117	zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ?????
[3]	118
[2839]	119	write(narea+200,*)'A', jfl,iafl,ibfl
[3]	120
[2839]	121	IF( lk_mpp ) THEN
	122
	123	iafloc = mi1( iafl )
	124	ibfloc = mj1( ibfl )
	125
	126	IF( nldi <= iafloc .AND. iafloc <= nlei .AND. &
	127	& nldj <= ibfloc .AND. ibfloc <= nlej ) THEN
	128
	129	write(narea+200,*)'B',jfl,iafloc,ibfloc,glamt(iafloc ,ibfloc )
	130	write(narea+200,*)'B',zafl,zbfl
	131
	132	!the float is inside of current proc's area
[16]	133	ia1floc = iafloc + 1
	134	ib1floc = ibfloc + 1
[2839]	135
	136	!save position of the float
	137	zlat(jfl) = (1.-zafl)(1.-zbfl)gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) &
	138	+ zafl (1.-zbfl)gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)
	139	zlon(jfl) = (1.-zafl)(1.-zbfl)glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) &
	140	+ zafl (1.-zbfl)glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc)
	141	zdep(jfl) = (1.-zcfl)fsdepw(iafloc,ibfloc,icfl ) + zcfl fsdepw(iafloc,ibfloc,ic1fl)
[16]	142
[2839]	143	!save temperature, salinity and density at this position
	144	ztem(jfl) = tn(iafloc,ibfloc,icfl)
	145	zsal (jfl) = sn(iafloc,ibfloc,icfl)
	146	zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
	147
	148	ELSE ! the float is not inside of current proc's area
	149	!write(narea+200,*)"notinside current proc: jfl ",jfl
[16]	150
[2839]	151	zlon(jfl) = 0.
	152	zlat(jfl) = 0.
	153	zdep(jfl) = 0.
	154
	155	!ztemp(1:jpk,jfl) = 0.
	156	!zsal (1:jpk,jfl) = 0.
	157	!zrho (1:jpk,jfl) = 0.
	158	ztem(jfl) = 0.
	159	zsal (jfl) = 0.
	160	zrho (jfl) = 0.
	161
[16]	162	ENDIF
	163
[2839]	164	ELSE ! mono proc case
[16]	165
	166	iafloc = iafl
	167	ibfloc = ibfl
[3]	168	ia1floc = iafloc + 1
	169	ib1floc = ibfloc + 1
[2839]	170
	171	!save position of the float
	172	zlat(jfl) = (1.-zafl)(1.-zbfl)gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) &
[3]	173	+ zafl (1.-zbfl)gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc)
[2839]	174	zlon(jfl) = (1.-zafl)(1.-zbfl)glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) &
[3]	175	+ zafl (1.-zbfl)glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc)
[2839]	176	zdep(jfl) = (1.-zcfl)fsdepw(iafloc,ibfloc,icfl ) + zcfl fsdepw(iafloc,ibfloc,ic1fl)
[3]	177
[2839]	178	ztem(jfl) = tn(iafloc,ibfloc,icfl)
	179	zsal(jfl) = sn(iafloc,ibfloc,icfl)
	180	zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0
	181
	182	ENDIF
	183
	184	END DO ! loop on float
	185
	186	IF( lk_mpp ) THEN
	187
	188	! Only proc 0 writes all positions
	189
	190	!SUM of positions on all procs
	191	write(narea+200,*)"zlon avt mpp_sum ",zlon
	192	CALL mpp_sum( zlon, jpnfl ) ! sums over the global domain
	193	write(narea+200,*)"zlon apr mpp_sum ",zlon
	194	CALL mpp_sum( zlat, jpnfl ) ! sums over the global domain
	195	CALL mpp_sum( zdep, jpnfl ) ! sums over the global domain
	196	CALL mpp_sum( ztem, jpnfl ) ! sums over the global domain
	197	CALL mpp_sum( zsal, jpnfl ) ! sums over the global domain
	198	CALL mpp_sum( zrho, jpnfl ) ! sums over the global domain
	199
[16]	200	ENDIF
[3]	201
[2839]	202
	203	!ENDIF !end of saving variables
	204
	205
	206	!---------------------------------!
	207	! WRITE WRITE WRITE WRITE WRITE !
	208	!---------------------------------!
	209
	210	!-----------------------------------------------------
	211	! II- Write in ascii file
	212	!-----------------------------------------------------
	213
	214	IF( ln_flo_ascii )THEN
	215
	216	IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
	217
	218	!II-2-a Open ascii file
	219	!----------------------
	220	IF( kt == nn_it000 ) THEN
	221	CALL ctl_opn( numfl, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
	222	irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) )
	223	WRITE(numfl,*)cexper,no,irecflo,jpnfl,nn_writefl
	224	ENDIF
	225
	226	!III-2-b Write in ascii file
	227	!-----------------------------
	228	WRITE(numfl,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)
	229
	230
	231	!III-2-c Close netcdf file
	232	!-------------------------
	233	IF( kt == nitend ) CLOSE( numfl )
	234
[3]	235	ENDIF
	236
[2839]	237	!-----------------------------------------------------
	238	! III- Write in netcdf file
	239	!-----------------------------------------------------
[3]	240
[2839]	241	ELSE
[3]	242
[2839]	243	#if defined key_iomput
	244	IF(lwp)WRITE(numout,*)"zlon ",zlon ; call FLUSH(numout)
	245	CALL iom_put( "traj_lon" , zlon )
	246	CALL iom_put( "traj_lat" , zlat )
	247	CALL iom_put( "traj_dep" , zdep )
	248	CALL iom_put( "traj_temp" , ztem )
	249	CALL iom_put( "traj_salt" , zsal )
	250	CALL iom_put( "traj_dens" , zrho )
	251	CALL iom_put( "traj_group" , REAL(ngrpfl,wp) )
	252	#else
	253
	254	!III-2 Write with IOIPSL
	255	!----------------------
	256
	257	IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN
	258
	259
	260	!III-2-a Open netcdf file
	261	!-----------------------
	262	IF( kt==nn_it000 )THEN ! Create and open
	263
	264	CALL dia_nam( clname, nn_writefl, 'trajec_float' )
	265	clname=TRIM(clname)//".nc"
	266
	267	CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1 /) , numfl )
	268
	269	CALL fliodefv( numfl, 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" )
	270	CALL fliodefv( numfl, 'traj_lat' , (/1,2/), v_t=flio_r8, long_name="Latitude" , units="degrees_north" )
	271	CALL fliodefv( numfl, 'traj_depth' , (/1,2/), v_t=flio_r8, long_name="Depth" , units="meters" )
	272	CALL fliodefv( numfl, 'time_counter', (/2/) , v_t=flio_r8, long_name="Time axis" &
	273	& , units="seconds since start of the run " )
	274	CALL fliodefv( numfl, 'traj_temp' , (/1,2/), v_t=flio_r8, long_name="Temperature" , units="C" )
	275	CALL fliodefv( numfl, 'traj_salt' , (/1,2/), v_t=flio_r8, long_name="Salinity" , units="PSU" )
	276	CALL fliodefv( numfl, 'traj_dens' , (/1,2/), v_t=flio_r8, long_name="Density" , units="kg/m3" )
	277	CALL fliodefv( numfl, 'traj_group' , (/1/) , v_t=flio_r8, long_name="number of the group" , units="no unit" )
	278
	279	CALL flioputv( numfl , 'traj_group' , REAL(ngrpfl,wp) )
	280
	281	ELSE ! Re-open
	282
	283	CALL flioopfd( TRIM(clname), numfl , "WRITE" )
	284
	285	ENDIF
	286
	287	!III-2-b Write in netcdf file
	288	!-----------------------------
	289	irec = INT( (kt-nn_it000+1)/nn_writefl ) +1
	290	ztime = ( kt-nn_it000 + 1 ) * rdt
	291
	292	CALL flioputv( numfl , 'time_counter', ztime , start=(/irec/) )
	293
[16]	294	DO jfl = 1, jpnfl
[2839]	295
	296	istart = (/jfl,irec/)
	297	icfl = INT( tpkfl(jfl) ) ! K-index of the nearest point before
	298
	299	CALL flioputv( numfl , 'traj_lon' , zlon(jfl) , start=istart )
	300	CALL flioputv( numfl , 'traj_lat' , zlat(jfl) , start=istart )
	301	CALL flioputv( numfl , 'traj_depth' , zdep(jfl) , start=istart )
	302	CALL flioputv( numfl , 'traj_temp' , ztemp(icfl,jfl) , start=istart )
	303	CALL flioputv( numfl , 'traj_salt' , zsal(icfl,jfl) , start=istart )
	304	CALL flioputv( numfl , 'traj_dens' , zrho(icfl,jfl) , start=istart )
	305
	306	ENDDO
	307
	308	!III-2-c Close netcdf file
	309	!-------------------------
	310	CALL flioclo( numfl )
	311
[3]	312	ENDIF
	313
[2839]	314	#endif
	315	ENDIF ! netcdf writing
	316
[3]	317	END SUBROUTINE flo_wri
	318
[2839]	319
[3]	320	# else
	321	!!----------------------------------------------------------------------
	322	!! Default option Empty module
	323	!!----------------------------------------------------------------------
	324	CONTAINS
	325	SUBROUTINE flo_wri ! Empty routine
	326	END SUBROUTINE flo_wri
	327	#endif
[2839]	328
	329	!!=======================================================================
[3]	330	END MODULE flowri

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

Download in other formats: