- Timestamp:
- 2011-09-15T08:41:58+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r2715 r2839 2 2 !!====================================================================== 3 3 !! *** MODULE flowri *** 4 !! lagrangian floats : outputs4 !! blablabla: floteur.... 5 5 !!====================================================================== 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 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 9 11 !!---------------------------------------------------------------------- 10 12 #if defined key_floats || defined key_esopa … … 12 14 !! 'key_floats' float trajectories 13 15 !!---------------------------------------------------------------------- 14 !! flowri : write trajectories of floats in file 15 !! ----------------------------------------------------------------------16 17 !! * Modules used 16 18 USE flo_oce ! ocean drifting floats 17 19 USE oce ! ocean dynamics and tracers … … 19 21 USE lib_mpp ! distribued memory computing library 20 22 USE in_out_manager ! I/O manager 23 USE phycst ! physic constants 24 USE dianam ! build name of file (routine) 25 USE ioipsl 26 USE iom ! I/O library 27 21 28 22 29 IMPLICIT NONE 23 30 PRIVATE 24 31 25 PUBLIC flo_wri! routine called by floats.F9026 PUBLIC 27 28 INTEGER :: 29 INTEGER :: numflo ! logical unit for drifting floats32 PUBLIC flo_wri ! routine called by floats.F90 33 PUBLIC flo_wri_alloc ! routine called by floats.F90 34 35 INTEGER :: jfl ! number of floats 36 CHARACTER (len=80) :: clname ! netcdf output filename 30 37 31 38 ! Following are only workspace arrays but shape is not (jpi,jpj) and 32 39 ! therefore make them module arrays rather than replacing with wrk_nemo 33 40 ! member arrays. 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztemp, zsal ! 2D workspace 41 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zlon , zlat, zdep ! 2D workspace 42 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ztem, zsal, zrho ! 2D workspace 35 43 36 44 !! * Substitutions 37 45 # include "domzgr_substitute.h90" 38 46 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 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 50 !!---------------------------------------------------------------------- 51 43 52 CONTAINS 44 53 … … 47 56 !! *** FUNCTION flo_wri_alloc *** 48 57 !!------------------------------------------------------------------- 49 ALLOCATE( ztemp(jpk,jpnfl) , zsal(jpk,jpnfl) , STAT=flo_wri_alloc) 50 ! 58 ALLOCATE( ztem(jpnfl) , zsal(jpnfl) , zrho(jpnfl) , & 59 zlon(jpnfl) , zlat(jpnfl) , zdep(jpnfl) , STAT=flo_wri_alloc) 60 ! 51 61 IF( lk_mpp ) CALL mpp_sum ( flo_wri_alloc ) 52 62 IF( flo_wri_alloc /= 0 ) CALL ctl_warn('flo_wri_alloc: failed to allocate arrays.') 53 63 END FUNCTION flo_wri_alloc 54 64 55 56 65 SUBROUTINE flo_wri( kt ) 57 !!------------------------------------------------------------------- 58 !! *** ROUTINE flo_wri 66 !!--------------------------------------------------------------------- 67 !! *** ROUTINE flo_wri *** 59 68 !! 60 !! ** Purpose : Write position of floats in "trajec_float" file 61 !! and the temperature and salinity at this position 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 !! 62 73 !! 63 !! ** Method : The frequency is nn_writefl 74 !! ** Method : The frequency of ??? is nwritefl 75 !! 64 76 !!---------------------------------------------------------------------- 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 !!--------------------------------------------------------------------- 77 !! * Arguments 78 INTEGER :: kt ! time step 79 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 !!---------------------------------------------------------------------- 76 97 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 97 98 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 98 !IF( MOD( kt,nn_writefl)== 0 ) THEN 99 100 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 106 107 DO jfl = 1, jpnfl 108 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 ????? 118 119 write(narea+200,*)'A', jfl,iafl,ibfl 120 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 118 133 ia1floc = iafloc + 1 119 134 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. 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) 142 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 150 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 139 162 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) 163 164 ELSE ! mono proc case 165 165 166 iafloc = iafl 166 167 ibfloc = ibfl 167 168 ia1floc = iafloc + 1 168 169 ib1floc = ibfloc + 1 169 ! 170 flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 170 171 !save position of the float 172 zlat(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc) & 171 173 + 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) &174 zlon(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc) & 173 175 + 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 176 zdep(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl) 177 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 194 200 ENDIF 195 201 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 251 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,*) '~~~~~~~ ' 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 259 235 ENDIF 260 236 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) 237 !----------------------------------------------------- 238 ! III- Write in netcdf file 239 !----------------------------------------------------- 240 241 ELSE 242 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 294 DO jfl = 1, jpnfl 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 285 312 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 ! 313 314 #endif 315 ENDIF ! netcdf writing 316 313 317 END SUBROUTINE flo_wri 318 314 319 315 320 # else … … 321 326 END SUBROUTINE flo_wri 322 327 #endif 323 324 !!====================================================================== 328 329 !!======================================================================= 325 330 END MODULE flowri
Note: See TracChangeset
for help on using the changeset viewer.
