Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r2715 r3294 2 2 !!====================================================================== 3 3 !! *** MODULE flowri *** 4 !! lagrangian floats : outputs 4 !! 5 !! write floats trajectory in ascii ln_flo_ascii = T 6 !! or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F 7 !! 8 !! 5 9 !!====================================================================== 6 !! History : OPA ! 1999-09 (Y. Drillet) Original code 7 !! ! 2000-06 (J.-M. Molines) Profiling floats for CLS 8 !! NEMO 1.0 ! 2002-11 (G. Madec, A. Bozec) F90: Free form and module 10 !! History : 11 !! 8.0 ! 99-09 (Y. Drillet) : Original code 12 !! ! 00-06 (J.-M. Molines) : Profiling floats for CLS 13 !! 8.5 ! 02-10 (A. Bozec) F90 : Free form and module 14 !! 3.2 ! 10-08 (slaw, cbricaud): netcdf outputs and others 9 15 !!---------------------------------------------------------------------- 10 16 #if defined key_floats || defined key_esopa … … 12 18 !! 'key_floats' float trajectories 13 19 !!---------------------------------------------------------------------- 14 !! flowri : write trajectories of floats in file 15 !! ----------------------------------------------------------------------20 21 !! * Modules used 16 22 USE flo_oce ! ocean drifting floats 17 23 USE oce ! ocean dynamics and tracers … … 19 25 USE lib_mpp ! distribued memory computing library 20 26 USE in_out_manager ! I/O manager 27 USE phycst ! physic constants 28 USE dianam ! build name of file (routine) 29 USE ioipsl 30 USE iom ! I/O library 31 21 32 22 33 IMPLICIT NONE 23 34 PRIVATE 24 35 25 PUBLIC 26 PUBLIC 27 28 INTEGER :: jfl! number of floats29 INTEGER :: numflo ! logical unit for drifting floats36 PUBLIC flo_wri ! routine called by floats.F90 37 PUBLIC flo_wri_alloc ! routine called by floats.F90 38 39 INTEGER :: jfl ! number of floats 40 CHARACTER (len=80) :: clname ! netcdf output filename 30 41 31 42 ! Following are only workspace arrays but shape is not (jpi,jpj) and 32 43 ! therefore make them module arrays rather than replacing with wrk_nemo 33 44 ! member arrays. 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztemp, zsal ! 2D workspace 45 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zlon , zlat, zdep ! 2D workspace 46 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ztem , zsal, zrho ! 2D workspace 35 47 36 48 !! * Substitutions 37 49 # include "domzgr_substitute.h90" 38 50 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 52 !! $Header: 53 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 54 !!---------------------------------------------------------------------- 55 43 56 CONTAINS 44 57 45 INTEGER FUNCTION flo_wri_alloc 58 INTEGER FUNCTION flo_wri_alloc() 46 59 !!------------------------------------------------------------------- 47 60 !! *** FUNCTION flo_wri_alloc *** 48 61 !!------------------------------------------------------------------- 49 ALLOCATE( ztemp(jpk,jpnfl) , zsal(jpk,jpnfl) , STAT=flo_wri_alloc) 50 ! 62 ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , & 63 zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc) 64 ! 51 65 IF( lk_mpp ) CALL mpp_sum ( flo_wri_alloc ) 52 66 IF( flo_wri_alloc /= 0 ) CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.') 53 67 END FUNCTION flo_wri_alloc 54 68 55 56 69 SUBROUTINE flo_wri( kt ) 57 !!------------------------------------------------------------------- 58 !! *** ROUTINE flo_wri 70 !!--------------------------------------------------------------------- 71 !! *** ROUTINE flo_wri *** 59 72 !! 60 !! ** Purpose : Write position of floats in "trajec_float" file 61 !! and the temperature and salinity at this position 73 !! ** Purpose : Write position of floats in "trajec_float.nc",according 74 !! to ARIANE TOOLS (http://stockage.univ-brest.fr/~grima/Ariane/ ) n 75 !! nomenclature 76 !! 62 77 !! 63 !! ** Method : The frequency is nn_writefl 78 !! ** Method : The frequency of ??? is nwritefl 79 !! 64 80 !!---------------------------------------------------------------------- 65 INTEGER :: kt ! time step 66 !! 67 CHARACTER (len=21) :: clname 68 INTEGER :: inum ! temporary logical unit for restart file 69 INTEGER :: iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo 70 INTEGER :: iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln 71 INTEGER :: ic, jc , jpn 72 INTEGER, DIMENSION ( jpnij ) :: iproc 73 REAL(wp) :: zafl, zbfl, zcfl, zdtj 74 REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 75 !!--------------------------------------------------------------------- 81 !! * Arguments 82 INTEGER :: kt ! time step 83 84 !! * Local declarations 85 INTEGER :: iafl , ibfl , icfl ! temporary integer 86 INTEGER :: ia1fl, ib1fl, ic1fl ! " 87 INTEGER :: iafloc,ibfloc,ia1floc,ib1floc ! " 88 INTEGER :: irec, irecflo 89 90 REAL(wp) :: zafl,zbfl,zcfl ! temporary real 91 REAL(wp) :: ztime ! " 92 93 INTEGER, DIMENSION(2) :: icount 94 INTEGER, DIMENSION(2) :: istart 95 INTEGER, DIMENSION(1) :: ish 96 INTEGER, DIMENSION(2) :: ish2 97 !!---------------------------------------------------------------------- 76 98 77 IF( kt == nit000 .OR. MOD( kt,nn_writefl) == 0 ) THEN 78 79 ! header of output floats file 80 81 IF(lwp) THEN 82 WRITE(numout,*) 83 WRITE(numout,*) 'flo_wri : write in trajec_float file ' 84 WRITE(numout,*) '~~~~~~~ ' 85 ENDIF 86 87 ! open the file numflo 88 CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 89 90 IF( kt == nit000 ) THEN 91 irecflo = NINT( (nitend-nit000) / FLOAT(nn_writefl) ) 92 IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl 93 ENDIF 94 zdtj = rdt / 86400._wp 95 96 ! translation of index position in geographical position 99 !----------------------------------------------------- 100 ! I- Save positions, temperature, salinty and density 101 !----------------------------------------------------- 102 zlon(:)=0.0 ; zlat(:)=0.0 ; zdep(:)=0.0 103 ztem(:)=0.0 ; zsal(:)=0.0 ; zrho(:)=0.0 104 105 DO jfl = 1, jpnfl 106 107 iafl = INT (tpifl(jfl)) ! I-index of the nearest point before 108 ibfl = INT (tpjfl(jfl)) ! J-index of the nearest point before 109 icfl = INT (tpkfl(jfl)) ! K-index of the nearest point before 110 ia1fl = iafl + 1 ! I-index of the nearest point after 111 ib1fl = ibfl + 1 ! J-index of the nearest point after 112 ic1fl = icfl + 1 ! K-index of the nearest point after 113 zafl = tpifl(jfl) - REAL(iafl,wp) ! distance ????? 114 zbfl = tpjfl(jfl) - REAL(ibfl,wp) ! distance ????? 115 zcfl = tpkfl(jfl) - REAL(icfl,wp) ! distance ????? 97 116 98 117 IF( lk_mpp ) THEN 99 DO jfl = 1, jpnfl 100 iafl = INT ( tpifl(jfl) ) 101 ibfl = INT ( tpjfl(jfl) ) 102 icfl = INT ( tpkfl(jfl) ) 103 iafln = NINT( tpifl(jfl) ) 104 ibfln = NINT( tpjfl(jfl) ) 105 ia1fl = iafl + 1 106 ib1fl = ibfl + 1 107 ic1fl = icfl + 1 108 zafl = tpifl(jfl) - FLOAT( iafl ) 109 zbfl = tpjfl(jfl) - FLOAT( ibfl ) 110 zcfl = tpkfl(jfl) - FLOAT( icfl ) 111 IF( iafl >= mig(nldi)-jpizoom+1 .AND. iafl <= mig(nlei)-jpizoom+1 .AND. & 112 & ibfl >= mjg(nldj)-jpjzoom+1 .AND. ibfl <= mjg(nlej)-jpjzoom+1 ) THEN 113 114 ! local index 115 116 iafloc = iafl -(mig(1)-jpizoom+1) + 1 117 ibfloc = ibfl -(mjg(1)-jpjzoom+1) + 1 118 ia1floc = iafloc + 1 119 ib1floc = ibfloc + 1 120 121 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 122 & + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 123 flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 124 & + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 125 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 126 127 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 128 ! We save the instantaneous profile of T and S of the column 129 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 130 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 131 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 132 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 133 ELSE 134 flxx(jfl) = 0. 135 flyy(jfl) = 0. 136 flzz(jfl) = 0. 137 ztemp(1:jpk,jfl) = 0. 138 zsal (1:jpk,jfl) = 0. 139 ENDIF 140 END DO 141 142 CALL mpp_sum( flxx, jpnfl ) ! sums over the global domain 143 CALL mpp_sum( flyy, jpnfl ) 144 CALL mpp_sum( flzz, jpnfl ) 145 ! these 2 lines have accendentaly been removed from ATL6-V8 run hence 146 ! giving 0 salinity and temperature on the float trajectory 147 !bug RB 148 !compilation failed in mpp 149 ! CALL mpp_sum( ztemp, jpk*jpnfl ) 150 ! CALL mpp_sum( zsal , jpk*jpnfl ) 151 152 ELSE 153 DO jfl = 1, jpnfl 154 iafl = INT (tpifl(jfl)) 155 ibfl = INT (tpjfl(jfl)) 156 icfl = INT (tpkfl(jfl)) 157 iafln = NINT(tpifl(jfl)) 158 ibfln = NINT(tpjfl(jfl)) 159 ia1fl = iafl+1 160 ib1fl = ibfl+1 161 ic1fl = icfl+1 162 zafl = tpifl(jfl) - FLOAT(iafl) 163 zbfl = tpjfl(jfl) - FLOAT(ibfl) 164 zcfl = tpkfl(jfl) - FLOAT(icfl) 165 iafloc = iafl 166 ibfloc = ibfl 118 119 iafloc = mi1( iafl ) 120 ibfloc = mj1( ibfl ) 121 122 IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 123 & nldj <= ibfloc .AND. ibfloc <= nlej ) THEN 124 125 !the float is inside of current proc's area 167 126 ia1floc = iafloc + 1 168 127 ib1floc = ibfloc + 1 169 ! 170 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 171 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 172 flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 173 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 174 flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 175 !ALEX 176 ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL 177 zxxu_11 = glamt(iafloc ,ibfloc ) 178 zxxu_10 = glamt(iafloc ,ib1floc) 179 zxxu_01 = glamt(ia1floc,ibfloc ) 180 zxxu = glamt(ia1floc,ib1floc) 181 182 IF( iafloc == 52 ) zxxu_10 = -181 183 IF( iafloc == 52 ) zxxu_11 = -181 184 flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)* zbfl * zxxu_10 & 185 + zafl *(1.-zbfl)* zxxu_01 + zafl * zbfl * zxxu 186 !ALEX 187 ! Change by Alexandra Bozec et Jean-Philippe Boulanger 188 ! We save the instantaneous profile of T and S of the column 189 ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 190 ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 191 ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 192 zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 193 END DO 128 129 !save position of the float 130 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 131 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 132 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 133 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 134 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 135 136 !save temperature, salinity and density at this position 137 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 138 zsal (jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 139 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 140 141 ENDIF 142 143 ELSE ! mono proc case 144 145 iafloc = iafl 146 ibfloc = ibfl 147 ia1floc = iafloc + 1 148 ib1floc = ibfloc + 1 149 150 !save position of the float 151 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 152 + zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) + zafl * zbfl * gphit(ia1floc,ib1floc) 153 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 154 + zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) + zafl * zbfl * glamt(ia1floc,ib1floc) 155 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 156 157 ztem(jfl) = tsn(iafloc,ibfloc,icfl,jp_tem) 158 zsal(jfl) = tsn(iafloc,ibfloc,icfl,jp_sal) 159 zrho(jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 160 194 161 ENDIF 195 162 196 ! 197 WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp) 198 !! 199 !! case when profiles are dumped. In order to save memory, dumps are 200 !! done level by level. 201 ! IF (mod(kt,nflclean) == 0.) THEN 202 !! IF ( nwflo == nwprofil ) THEN 203 ! DO jk = 1,jpk 204 ! DO jfl=1,jpnfl 205 ! iafl= INT(tpifl(jfl)) 206 ! ibfl=INT(tpjfl(jfl)) 207 ! iafln=NINT(tpifl(jfl)) 208 ! ibfln=NINT(tpjfl(jfl)) 209 !# if defined key_mpp_mpi 210 ! IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND. 211 ! $ (iafl <= (mig(nlei)-jpizoom+1)) .AND. 212 ! $ (ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. 213 ! $ (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN 214 !! 215 !! local index 216 !! 217 ! iafloc=iafln-(mig(1)-jpizoom+1)+1 218 ! ibfloc=ibfln-(mjg(1)-jpjzoom+1)+1 219 !! IF (jk == 1 ) THEN 220 !! PRINT *,'<<<>>> ',jfl,narea, iafloc ,ibfloc, iafln, ibfln,adatrj 221 !! ENDIF 222 !# else 223 ! iafloc=iafln 224 ! ibfloc=ibfln 225 !# endif 226 ! ztemp(jfl)=tn(iafloc,ibfloc,jk) 227 ! zsal(jfl)=sn(iaflo!,ibfloc,jk) 228 !# if defined key_mpp_mpi 229 ! ELSE 230 ! ztemp(jfl) = 0. 231 ! zsal(jfl) = 0. 232 ! ENDIF 233 !# endif 234 !! ... next float 235 ! END DO 236 ! IF( lk_mpp ) CALL mpp_sum( ztemp, jpnfl ) 237 ! IF( lk_mpp ) CALL mpp_sum( zsal , jpnfl ) 238 ! 239 ! IF (lwp) THEN 240 ! WRITE(numflo) ztemp, zsal 241 ! ENDIF 242 !! ... next level jk 243 ! END DO 244 !! ... reset nwflo to 0 for ALL processors, if profile has been written 245 !! nwflo = 0 246 ! ENDIF 247 !! 248 ! CALL flush (numflo) 249 !! ... time of dumping floats 250 !! END IF 163 END DO ! loop on float 164 165 !Only proc 0 writes all positions : SUM of positions on all procs 166 IF( lk_mpp ) THEN 167 CALL mpp_sum( zlon, jpnfl ) ! sums over the global domain 168 CALL mpp_sum( zlat, jpnfl ) ! sums over the global domain 169 CALL mpp_sum( zdep, jpnfl ) ! sums over the global domain 170 CALL mpp_sum( ztem, jpnfl ) ! sums over the global domain 171 CALL mpp_sum( zsal, jpnfl ) ! sums over the global domain 172 CALL mpp_sum( zrho, jpnfl ) ! sums over the global domain 251 173 ENDIF 252 253 IF( (MOD(kt,nn_stockfl) == 0) .OR. ( kt == nitend ) ) THEN 254 ! Writing the restart file 255 IF(lwp) THEN 256 WRITE(numout,*) 257 WRITE(numout,*) 'flo_wri : write in restart_float file ' 258 WRITE(numout,*) '~~~~~~~ ' 174 175 176 !-------------------------------------! 177 ! II- WRITE WRITE WRITE WRITE WRITE ! 178 !-------------------------------------! 179 180 !--------------------------! 181 ! II-1 Write in ascii file ! 182 !--------------------------! 183 184 IF( ln_flo_ascii )THEN 185 186 IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN 187 188 !II-1-a Open ascii file 189 !---------------------- 190 IF( kt == nn_it000 ) THEN 191 CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 192 irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) ) 193 WRITE(numflo,*)cexper,no,irecflo,jpnfl,nn_writefl 194 ENDIF 195 196 !II-1-b Write in ascii file 197 !----------------------------- 198 WRITE(numflo,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp) 199 200 201 !II-1-c Close netcdf file 202 !------------------------- 203 IF( kt == nitend ) CLOSE( numflo ) 204 259 205 ENDIF 260 206 261 ! file is opened and closed every time it is used. 262 263 clname = 'restart.float.' 264 ic = 1 265 DO jc = 1, 16 266 IF( cexper(jc:jc) /= ' ' ) ic = jc 267 END DO 268 clname = clname(1:14)//cexper(1:ic) 269 ic = 1 270 DO jc = 1, 48 271 IF( clname(jc:jc) /= ' ' ) ic = jc 272 END DO 273 274 CALL ctl_opn( inum, clname, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 275 REWIND inum 276 ! 277 DO jpn = 1, jpnij 278 iproc(jpn) = 0 279 END DO 280 ! 281 IF(lwp) THEN 282 REWIND(inum) 283 WRITE (inum) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl 284 CLOSE (inum) 207 !----------------------------------------------------- 208 ! II-2 Write in netcdf file 209 !----------------------------------------------------- 210 211 ELSE 212 213 !II-2-a Write with IOM 214 !---------------------- 215 216 #if defined key_iomput 217 CALL iom_put( "traj_lon" , zlon ) 218 CALL iom_put( "traj_lat" , zlat ) 219 CALL iom_put( "traj_dep" , zdep ) 220 CALL iom_put( "traj_temp" , ztem ) 221 CALL iom_put( "traj_salt" , zsal ) 222 CALL iom_put( "traj_dens" , zrho ) 223 CALL iom_put( "traj_group" , REAL(ngrpfl,wp) ) 224 #else 225 226 !II-2-b Write with IOIPSL 227 !------------------------ 228 229 IF( ( kt == nn_it000 .OR. MOD( kt,nn_writefl)== 0 ) .AND. lwp )THEN 230 231 232 !II-2-b-1 Open netcdf file 233 !------------------------- 234 IF( kt==nn_it000 )THEN ! Create and open 235 236 CALL dia_nam( clname, nn_writefl, 'trajec_float' ) 237 clname=TRIM(clname)//".nc" 238 239 CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1 /) , numflo ) 240 241 CALL fliodefv( numflo, 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" ) 242 CALL fliodefv( numflo, 'traj_lat' , (/1,2/), v_t=flio_r8, long_name="Latitude" , units="degrees_north" ) 243 CALL fliodefv( numflo, 'traj_depth' , (/1,2/), v_t=flio_r8, long_name="Depth" , units="meters" ) 244 CALL fliodefv( numflo, 'time_counter', (/2/) , v_t=flio_r8, long_name="Time axis" & 245 & , units="seconds since start of the run " ) 246 CALL fliodefv( numflo, 'traj_temp' , (/1,2/), v_t=flio_r8, long_name="Temperature" , units="C" ) 247 CALL fliodefv( numflo, 'traj_salt' , (/1,2/), v_t=flio_r8, long_name="Salinity" , units="PSU" ) 248 CALL fliodefv( numflo, 'traj_dens' , (/1,2/), v_t=flio_r8, long_name="Density" , units="kg/m3" ) 249 CALL fliodefv( numflo, 'traj_group' , (/1/) , v_t=flio_r8, long_name="number of the group" , units="no unit" ) 250 251 CALL flioputv( numflo , 'traj_group' , REAL(ngrpfl,wp) ) 252 253 ELSE ! Re-open 254 255 CALL flioopfd( TRIM(clname), numflo , "WRITE" ) 256 257 ENDIF 258 259 !II-2-b-2 Write in netcdf file 260 !------------------------------- 261 irec = INT( (kt-nn_it000+1)/nn_writefl ) +1 262 ztime = ( kt-nn_it000 + 1 ) * rdt 263 264 CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) 265 266 DO jfl = 1, jpnfl 267 268 istart = (/jfl,irec/) 269 icfl = INT( tpkfl(jfl) ) ! K-index of the nearest point before 270 271 CALL flioputv( numflo , 'traj_lon' , zlon(jfl) , start=istart ) 272 CALL flioputv( numflo , 'traj_lat' , zlat(jfl) , start=istart ) 273 CALL flioputv( numflo , 'traj_depth' , zdep(jfl) , start=istart ) 274 CALL flioputv( numflo , 'traj_temp' , ztemp(icfl,jfl) , start=istart ) 275 CALL flioputv( numflo , 'traj_salt' , zsal(icfl,jfl) , start=istart ) 276 CALL flioputv( numflo , 'traj_dens' , zrho(icfl,jfl) , start=istart ) 277 278 ENDDO 279 280 !II-2-b-3 Close netcdf file 281 !--------------------------- 282 CALL flioclo( numflo ) 283 285 284 ENDIF 286 ! 287 ! Compute the number of trajectories for each processor 288 ! 289 IF( lk_mpp ) THEN 290 DO jfl = 1, jpnfl 291 IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND. & 292 &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND. & 293 &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. & 294 &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 295 iproc(narea) = iproc(narea)+1 296 ENDIF 297 END DO 298 CALL mpp_sum( iproc, jpnij ) 299 ! 300 IF(lwp) THEN 301 WRITE(numout,*) 'DATE',adatrj 302 DO jpn = 1, jpnij 303 IF( iproc(jpn) /= 0 ) THEN 304 WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.' 305 ENDIF 306 END DO 307 ENDIF 308 ENDIF 309 ENDIF 310 311 IF( kt == nitend ) CLOSE( numflo ) 312 ! 285 286 #endif 287 ENDIF ! netcdf writing 288 313 289 END SUBROUTINE flo_wri 290 314 291 315 292 # else … … 321 298 END SUBROUTINE flo_wri 322 299 #endif 323 324 !!====================================================================== 300 301 !!======================================================================= 325 302 END MODULE flowri
Note: See TracChangeset
for help on using the changeset viewer.
