Changeset 2839 for branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM
- Timestamp:
- 2011-09-15T08:41:58+02:00 (13 years ago)
- Location:
- branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM
- Files:
-
- 1 added
- 13 edited
-
CONFIG/GYRE/EXP00/namelist (modified) (2 diffs)
-
CONFIG/ORCA2_LIM/EXP00/iodef.xml (modified) (3 diffs)
-
CONFIG/ORCA2_LIM/EXP00/namelist (modified) (2 diffs)
-
CONFIG/ORCA2_OFF_PISCES/EXP00/namelist (modified) (2 diffs)
-
CONFIG/POMME/EXP00/namelist (modified) (2 diffs)
-
NEMO/OPA_SRC/FLO/flo4rk.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/FLO/flo_oce.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/FLO/floats.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/FLO/flodom.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/FLO/florst.F90 (added)
-
NEMO/OPA_SRC/FLO/flowri.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/IOM/in_out_manager.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/IOM/iom.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/nemogcm.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r2715 r2839 750 750 &namflo ! float parameters ("key_float") 751 751 !----------------------------------------------------------------------- 752 jpnfl = 1 ! total number of floats during the run 753 jpnnewflo = 0 ! number of floats for the restart 752 754 ln_rstflo = .false. ! float restart (T) or not (F) 753 755 nn_writefl = 75 ! frequency of writing in float output file … … 756 758 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 757 759 ! or computed with Blanke' scheme (F) 760 ln_ariane = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 758 761 / 759 762 !----------------------------------------------------------------------- -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
r2729 r2839 204 204 <field id="saltot" description="global mean salinity" unit="psu" /> 205 205 <field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 206 </group> 207 208 <!-- variables available with key_float --> 209 <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point"> 210 <field id="traj_lon" description="floats longitude" unit="deg" /> 211 <field id="traj_lat" description="floats latitude" unit="deg" /> 212 <field id="traj_dep" description="floats depth" unit="m" /> 213 <field id="traj_temp" description="floats temperature" unit="degC" /> 214 <field id="traj_salt" description="floats salinity" unit="psu" /> 215 <field id="traj_dens" description="floats density" unit="kg/m3" /> 216 <field id="traj_group" description="floats group" unit="none" /> 206 217 </group> 207 218 … … 827 838 </group> 828 839 829 </group> 840 <file id="floats" description="floats variables"> 841 <field ref="traj_lon" name="floats_longitude" operation="inst(X)" /> 842 <field ref="traj_lat" name="floats_latitude" operation="inst(X)" /> 843 <field ref="traj_dep" name="floats_depth" operation="inst(X)" /> 844 <field ref="traj_temp" name="floats_temperature" operation="inst(X)" /> 845 <field ref="traj_salt" name="floats_salinity" operation="inst(X)" /> 846 <field ref="traj_dens" name="floats_density" operation="inst(X)" /> 847 <field ref="traj_group" name="floats_group" operation="inst(X)" /> 848 </file> 830 849 831 850 <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE."> <!-- 3d files --> … … 948 967 949 968 <axis_definition> 950 <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." /> 951 <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." /> 952 <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." /> 953 <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." /> 969 <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." /> 970 <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." /> 971 <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." /> 972 <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." /> 973 <axis id="nfloat" description="number of float" unit="none" positive=".false." /> 954 974 <axis id="none" description="axe non defini" unit="none" size="1" /> 955 975 </axis_definition> -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r2715 r2839 750 750 &namflo ! float parameters ("key_float") 751 751 !----------------------------------------------------------------------- 752 jpnfl = 1 ! total number of floats during the run 753 jpnnewflo = 0 ! number of floats for the restart 752 754 ln_rstflo = .false. ! float restart (T) or not (F) 753 755 nn_writefl = 75 ! frequency of writing in float output file … … 756 758 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 757 759 ! or computed with Blanke' scheme (F) 760 ln_ariane = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 758 761 / 759 762 !----------------------------------------------------------------------- -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r2715 r2839 764 764 &namflo ! float parameters ("key_float") 765 765 !----------------------------------------------------------------------- 766 jpnfl = 1 ! total number of floats during the run 767 jpnnewflo = 0 ! number of floats for the restart 766 768 ln_rstflo = .false. ! float restart (T) or not (F) 767 769 nn_writefl = 75 ! frequency of writing in float output file … … 771 773 ! or computed with Blanke' scheme (F) 772 774 ! or computed with Blanke' scheme (F) 775 ln_ariane = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 773 776 / 774 777 !----------------------------------------------------------------------- -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/CONFIG/POMME/EXP00/namelist
r2650 r2839 755 755 &namflo ! float parameters ("key_float") 756 756 !----------------------------------------------------------------------- 757 jpnfl = 1 ! total number of floats during the run 758 jpnnewflo = 0 ! number of floats for the restart 757 759 ln_rstflo = .false. ! float restart (T) or not (F) 758 760 nn_writefl = 75 ! frequency of writing in float output file … … 761 763 ln_flork4 = .false. ! trajectories computed with a 4th order Runge-Kutta (T) 762 764 ! or computed with Blanke' scheme (F) 765 ln_ariane = .true. ! Output with Ariane tool netcdf convention(T) or ascii file (F) 763 766 / 764 767 !----------------------------------------------------------------------- -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r2528 r2839 52 52 !! 53 53 INTEGER :: jfl, jind ! dummy loop indices 54 REAL(wp), DIMENSION(jpnfl) :: zgifl , zgjfl , zgkfl ! index RK positions55 REAL(wp), DIMENSION(jpnfl) :: zufl , zvfl , zwfl ! interpolated velocity at the float position56 REAL(wp), DIMENSION(jpnfl,4) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients54 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions 55 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position 56 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients 57 57 !!--------------------------------------------------------------------- 58 59 ALLOCATE ( zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl) ) 60 ALLOCATE ( zufl(jpnfl) , zvfl(jpnfl) , zwfl(jpnfl) ) 61 ALLOCATE ( zrkxfl(jpnfl,4), zrkyfl(jpnfl,4), zrkzfl(jpnfl,4) ) 58 62 59 63 IF( kt == nit000 ) THEN … … 145 149 END DO 146 150 END DO 151 ! 152 DEALLOCATE( zgifl , zgjfl , zgkfl ) 153 DEALLOCATE( zufl , zvfl , zwfl ) 154 DEALLOCATE( zrkxfl , zrkyfl , zrkzfl ) 147 155 ! 148 156 END SUBROUTINE flo_4rk -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
r2715 r2839 24 24 !! float parameters 25 25 !! ---------------- 26 INTEGER, PUBLIC , PARAMETER :: jpnfl = 23!: total number of floats during the run27 INTEGER, PUBLIC , PARAMETER :: jpnnewflo = 0!: number of floats added in a new run28 INTEGER, PUBLIC , PARAMETER :: jpnrstflo = jpnfl - jpnnewflo !: number of floats for the restart26 INTEGER, PUBLIC :: jpnfl !: total number of floats during the run 27 INTEGER, PUBLIC :: jpnnewflo !: number of floats added in a new run 28 INTEGER, PUBLIC :: jpnrstflo !: number of floats for the restart 29 29 30 30 !! float variables 31 31 !! --------------- 32 INTEGER , PUBLIC, DIMENSION(jpnfl) :: nisobfl !: =0 for a isobar float , =1 for a float following the w velocity 33 INTEGER , PUBLIC, DIMENSION(jpnfl) :: ngrpfl !: number to identify searcher group 32 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: nisobfl !: =0 for a isobar float , =1 for a float following the w velocity 33 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ngrpfl !: number to identify searcher group 34 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: nfloat !: number to identify searcher group 34 35 35 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: flxx , flyy , flzz !: long, lat, depth of float (decimal degree, m >0)36 REAL(wp), PUBLIC, DIMENSION(jpnfl) :: tpifl, tpjfl, tpkfl !: (i,j,k) indices of float position36 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: flxx , flyy , flzz !: long, lat, depth of float (decimal degree, m >0) 37 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: tpifl, tpjfl, tpkfl !: (i,j,k) indices of float position 37 38 38 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wb !: vertical velocity at previous time step (m s-1). 39 40 40 ! !!! * namelist namflo : langrangian floats * 41 LOGICAL, PUBLIC :: ln_rstflo = .FALSE. !: T/F float restart 42 LOGICAL, PUBLIC :: ln_argo = .FALSE. !: T/F argo type floats 43 LOGICAL, PUBLIC :: ln_flork4 = .FALSE. !: T/F 4th order Runge-Kutta 44 INTEGER, PUBLIC :: nn_writefl = 150 !: frequency of float output file 45 INTEGER, PUBLIC :: nn_stockfl = 450 !: frequency of float restart file 41 ! !!! * namelist namflo : langrangian floats * 42 LOGICAL, PUBLIC :: ln_rstflo = .FALSE. !: T/F float restart 43 LOGICAL, PUBLIC :: ln_argo = .FALSE. !: T/F argo type floats 44 LOGICAL, PUBLIC :: ln_flork4 = .FALSE. !: T/F 4th order Runge-Kutta 45 LOGICAL, PUBLIC :: ln_ariane = .FALSE. !: handle ariane input/output convention 46 LOGICAL, PUBLIC :: ln_flo_ascii = .FALSE. !: write in ascii (T) or in Netcdf (F) 47 48 INTEGER, PUBLIC :: nn_writefl = 150 !: frequency of float output file 49 INTEGER, PUBLIC :: nn_stockfl = 450 !: frequency of float restart file 46 50 47 51 !!---------------------------------------------------------------------- … … 56 60 !! *** FUNCTION flo_oce_alloc *** 57 61 !!---------------------------------------------------------------------- 58 ALLOCATE( wb(jpi,jpj,jpk) , STAT=flo_oce_alloc ) 62 ALLOCATE( wb(jpi,jpj,jpk) , nfloat(jpnfl) , nisobfl(jpnfl) , ngrpfl(jpnfl) , & 63 flxx(jpnfl) , flyy(jpnfl) , flzz(jpnfl) , & 64 tpifl(jpnfl) , tpjfl(jpnfl) , tpkfl(jpnfl) , STAT=flo_oce_alloc ) 59 65 ! 60 66 IF( lk_mpp ) CALL mpp_sum ( flo_oce_alloc ) -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r2715 r2839 19 19 USE flodom ! initialisation Module 20 20 USE flowri ! float output (flo_wri routine) 21 USE florst ! float restart (flo_rst routine) 21 22 USE flo4rk ! Trajectories, Runge Kutta scheme (flo_4rk routine) 22 23 USE floblk ! Trajectories, Blanke scheme (flo_blk routine) … … 56 57 IF( lk_mpp ) CALL mppsync ! synchronization of all the processor 57 58 ! 58 IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 ) CALL flo_wri( kt ) ! trajectories file 59 IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 ) CALL flo_wri( kt ) ! restart file 59 !IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 ) CALL flo_wri( kt ) ! trajectories file 60 CALL flo_wri( kt ) ! trajectories file 61 !??IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 ) CALL flo_wri( kt ) ! restart file 60 62 ! 61 63 wb(:,:,:) = wn(:,:,:) ! Save the old vertical velocity field … … 70 72 !! ** Purpose : Read the namelist of floats 71 73 !!---------------------------------------------------------------------- 72 NAMELIST/namflo/ ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4 74 INTEGER :: jfl 75 ! 76 NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 73 77 !!--------------------------------------------------------------------- 74 78 ! … … 83 87 WRITE(numout,*) 84 88 WRITE(numout,*) ' Namelist floats :' 85 WRITE(numout,*) ' restart ln_rstflo = ', ln_rstflo 86 WRITE(numout,*) ' frequency of float output file nn_writefl = ', nn_writefl 87 WRITE(numout,*) ' frequency of float restart file nn_stockfl = ', nn_stockfl 88 WRITE(numout,*) ' Argo type floats ln_argo = ', ln_argo 89 WRITE(numout,*) ' Computation of T trajectories ln_flork4 = ', ln_flork4 89 WRITE(numout,*) ' number of floats jpnfl = ', jpnfl 90 WRITE(numout,*) ' number of new floats jpnflnewflo = ', jpnnewflo 91 WRITE(numout,*) ' restart ln_rstflo = ', ln_rstflo 92 WRITE(numout,*) ' frequency of float output file nn_writefl = ', nn_writefl 93 WRITE(numout,*) ' frequency of float restart file nn_stockfl = ', nn_stockfl 94 WRITE(numout,*) ' Argo type floats ln_argo = ', ln_argo 95 WRITE(numout,*) ' Computation of T trajectories ln_flork4 = ', ln_flork4 96 WRITE(numout,*) ' Use of ariane convention ln_ariane = ', ln_ariane 97 WRITE(numout,*) ' ascii output (T) or netcdf output (F) ln_flo_ascii = ', ln_flo_ascii 98 90 99 ENDIF 91 100 ! … … 95 104 ! ! allocate flowri arrays 96 105 IF( flo_wri_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' ) 106 ! 107 !memory allocation 108 jpnrstflo = jpnfl-jpnnewflo 109 110 !vertical axe for netcdf IOM ouput 111 DO jfl=1,jpnfl ; nfloat(jfl)=jfl ; ENDDO 112 97 113 ! 98 114 CALL flo_dom ! compute/read initial position of floats -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r2528 r2839 43 43 !! the longitude (degree) and the depth (m). 44 44 !!---------------------------------------------------------------------- 45 LOGICAL :: llinmesh 46 INTEGER :: ji, jj, jk ! DO loop index on 3 directions 47 INTEGER :: jfl, jfl1 ! number of floats 48 INTEGER :: inum ! logical unit for file read 45 CHARACTER (len=21) :: clname ! floats initialisation filename 46 LOGICAL :: llinmesh 47 INTEGER :: ji, jj, jk ! DO loop index on 3 directions 48 INTEGER :: jfl, jfl1 ! number of floats 49 INTEGER :: inum ! logical unit for file read 50 INTEGER :: jtrash ! trash var for reading 51 INTEGER :: ierr 49 52 INTEGER, DIMENSION(jpnfl) :: iimfl, ijmfl, ikmfl ! index mesh of floats 50 53 INTEGER, DIMENSION(jpnfl) :: idomfl, ivtest, ihtest ! - - … … 66 69 67 70 ! read of the restart file 68 READ(inum )( tpifl (jfl), jfl=1, jpnrstflo), &71 READ(inum,*) ( tpifl (jfl), jfl=1, jpnrstflo), & 69 72 ( tpjfl (jfl), jfl=1, jpnrstflo), & 70 73 ( tpkfl (jfl), jfl=1, jpnrstflo), & … … 208 211 ENDIF 209 212 ELSE 210 IF(lwp) WRITE(numout,*) ' init_float read ' 213 214 IF( ln_ariane )THEN 215 216 IF(lwp) WRITE(numout,*) ' init_float read with ariane convention (mesh indexes)' 217 218 ! First initialisation of floats with ariane convention 219 ! 220 ! The indexes are read directly from file (warning ariane 221 ! convention, are refered to 222 ! U,V,W grids - and not T-) 223 ! The isobar advection is managed with the sign of tpkfl ( >0 -> 3D 224 ! advection, <0 -> 2D) 225 ! Some variables are not read, as - gl : time index; 4th 226 ! column 227 ! - transport : transport ; 5th 228 ! column 229 ! and paste in the jtrash var 230 ! At the end, ones need to replace the indexes on T grid 231 ! RMQ : there is no float groups identification ! 232 233 clname='init_float_ariane' 234 235 nisobfl = 1 ! we assume that by default we want 3D advection 236 237 ! we check that the number of floats in the init_file are consistant 238 ! with the namelist 239 IF( lwp ) THEN 240 jfl1=0 241 OPEN( unit=inum, file=clname,status='old',access='sequential',form='formatted') 242 DO WHILE (ierr .GE. 0) 243 jfl1=jfl1+1 244 READ (inum,*, iostat=ierr) 245 END DO 246 CLOSE(inum) 247 IF( (jfl1-1) .NE. jpnfl )THEN 248 WRITE (numout,*) ' STOP the number of floats in' ,clname,' = ',jfl1 249 WRITE (numout,*) ' is not equal to jfl= ',jpnfl 250 STOP 251 ENDIF 252 ENDIF 253 254 ! we get the init values 255 CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 256 & 1, numout, .TRUE., 1 ) 257 DO jfl = 1, jpnfl 258 READ(inum,*) tpifl(jfl),tpjfl(jfl),tpkfl(jfl),jtrash, jtrash 259 if(lwp)write(numout,*)"read : ",tpifl(jfl),tpjfl(jfl),tpkfl(jfl),jtrash, jtrash ; call flush(numout) 260 261 IF ( tpkfl(jfl) .LT. 0. ) nisobfl(jfl) = 0 !set the 2D advection according to init_float 262 ngrpfl(jfl)=jfl 263 END DO 264 265 ! conversion from ariane index to T grid index 266 tpkfl = abs(tpkfl)-0.5 ! reversed vertical axis 267 tpifl = tpifl+0.5 268 tpjfl = tpjfl+0.5 269 270 ! verif of non land point initialisation : no need if correct init 271 272 ELSE 273 IF(lwp) WRITE(numout,*) ' init_float read ' 211 274 212 ! First initialisation of floats213 ! the initials positions of floats are written in a file214 ! with a variable to know if it is a isobar float a number215 ! to identified who want the trajectories of this float and216 ! an index for the number of the float217 ! open the init file218 CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )219 READ(inum) (flxx(jfl) , jfl=1, jpnfl), &220 (flyy(jfl) , jfl=1, jpnfl), &221 (flzz(jfl) , jfl=1, jpnfl), &222 (nisobfl(jfl), jfl=1, jpnfl), &223 (ngrpfl(jfl) , jfl=1, jpnfl)224 CLOSE(inum)225 226 ! Test to find the grid point coordonate with the geographical position227 DO jfl = 1, jpnfl228 ihtest(jfl) = 0229 ivtest(jfl) = 0230 ikmfl(jfl) = 0275 ! First initialisation of floats 276 ! the initials positions of floats are written in a file 277 ! with a variable to know if it is a isobar float a number 278 ! to identified who want the trajectories of this float and 279 ! an index for the number of the float 280 ! open the init file 281 CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 282 READ(inum,*) (flxx(jfl) , jfl=1, jpnfl), & 283 (flyy(jfl) , jfl=1, jpnfl), & 284 (flzz(jfl) , jfl=1, jpnfl), & 285 (nisobfl(jfl), jfl=1, jpnfl), & 286 (ngrpfl(jfl) , jfl=1, jpnfl) 287 CLOSE(inum) 288 289 ! Test to find the grid point coordonate with the geographical position 290 DO jfl = 1, jpnfl 291 ihtest(jfl) = 0 292 ivtest(jfl) = 0 293 ikmfl(jfl) = 0 231 294 # if defined key_mpp_mpi 232 DO ji = MAX(nldi,2), nlei233 DO jj = MAX(nldj,2), nlej ! NO vector opt.234 # else 235 DO ji = 2, jpi236 DO jj = 2, jpj ! NO vector opt.295 DO ji = MAX(nldi,2), nlei 296 DO jj = MAX(nldj,2), nlej ! NO vector opt. 297 # else 298 DO ji = 2, jpi 299 DO jj = 2, jpj ! NO vector opt. 237 300 # endif 238 ! for each float we find the indexes of the mesh301 ! for each float we find the indexes of the mesh 239 302 240 CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 241 glamf(ji-1,jj ),gphif(ji-1,jj ), & 242 glamf(ji ,jj ),gphif(ji ,jj ), & 243 glamf(ji ,jj-1),gphif(ji ,jj-1), & 244 flxx(jfl) ,flyy(jfl) , & 245 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 246 IF(llinmesh) THEN 247 iimfl(jfl) = ji 248 ijmfl(jfl) = jj 249 ihtest(jfl) = ihtest(jfl)+1 250 DO jk = 1, jpk-1 251 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 252 ikmfl(jfl) = jk 253 ivtest(jfl) = ivtest(jfl) + 1 254 ENDIF 255 END DO 256 ENDIF 303 CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 304 glamf(ji-1,jj ),gphif(ji-1,jj ), & 305 glamf(ji ,jj ),gphif(ji ,jj ), & 306 glamf(ji ,jj-1),gphif(ji ,jj-1), & 307 flxx(jfl) ,flyy(jfl) , & 308 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 309 IF(llinmesh) THEN 310 iimfl(jfl) = ji 311 ijmfl(jfl) = jj 312 ihtest(jfl) = ihtest(jfl)+1 313 DO jk = 1, jpk-1 314 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 315 ikmfl(jfl) = jk 316 ivtest(jfl) = ivtest(jfl) + 1 317 ENDIF 318 END DO 319 ENDIF 320 END DO 257 321 END DO 258 END DO 259 260 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1 261 IF( ihtest(jfl) == 0 ) THEN 262 iimfl(jfl) = -1 263 ijmfl(jfl) = -1 264 ENDIF 265 END DO 322 323 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1 324 IF( ihtest(jfl) == 0 ) THEN 325 iimfl(jfl) = -1 326 ijmfl(jfl) = -1 327 ENDIF 328 END DO 266 329 267 ! A zero in the sum of the arrays "ihtest" and "ivtest"268 IF( lk_mpp ) CALL mpp_sum(ihtest,jpnfl) ! sums over the global domain269 IF( lk_mpp ) CALL mpp_sum(ivtest,jpnfl)270 271 DO jfl = 1, jpnfl272 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1 )) THEN273 IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH'274 ENDIF275 IF( ihtest(jfl) == 0 ) THEN276 IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH'277 ENDIF278 END DO330 ! A zero in the sum of the arrays "ihtest" and "ivtest" 331 IF( lk_mpp ) CALL mpp_sum(ihtest,jpnfl) ! sums over the global domain 332 IF( lk_mpp ) CALL mpp_sum(ivtest,jpnfl) 333 334 DO jfl = 1, jpnfl 335 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1 )) THEN 336 IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 337 ENDIF 338 IF( ihtest(jfl) == 0 ) THEN 339 IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 340 ENDIF 341 END DO 279 342 280 ! We compute the distance between the float and the face of the mesh281 DO jfl = 1, jpnfl282 ! Made only if the float is in the domain of the processor283 IF( (iimfl(jfl) >= 0 ) .AND. ( ijmfl(jfl) >= 0 ) ) THEN284 285 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST286 287 idomfl(jfl) = 0288 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl)=1289 290 ! Computation of the distance between the float291 ! and the faces of the mesh292 ! zdxab293 ! .294 ! B----.---------C295 ! | . |296 ! |<------>flo |297 ! | ^ |298 ! | |.....|....zdyad299 ! | | |300 ! A--------|-----D301 302 zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl))303 zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1))304 305 ! Translation of this distances (in meter) in indexes306 307 tpifl(jfl) = (iimfl(jfl)-0.5)+zdxab/ e1u(iimfl(jfl)-1,ijmfl(jfl))+(mig(1)-jpizoom)308 tpjfl(jfl) = (ijmfl(jfl)-0.5)+zdyad/ e2v(iimfl(jfl),ijmfl(jfl)-1)+(mjg(1)-jpjzoom)309 tpkfl(jfl) = (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl))*(ikmfl(jfl)) &310 / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) &311 + (flzz(jfl) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))*(ikmfl(jfl)+1) &312 / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))313 ELSE314 tpifl (jfl) = 0.e0315 tpjfl (jfl) = 0.e0316 tpkfl (jfl) = 0.e0317 idomfl(jfl) = 0318 ENDIF319 END DO343 ! We compute the distance between the float and the face of the mesh 344 DO jfl = 1, jpnfl 345 ! Made only if the float is in the domain of the processor 346 IF( (iimfl(jfl) >= 0 ) .AND. ( ijmfl(jfl) >= 0 ) ) THEN 347 348 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 349 350 idomfl(jfl) = 0 351 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl)=1 352 353 ! Computation of the distance between the float 354 ! and the faces of the mesh 355 ! zdxab 356 ! . 357 ! B----.---------C 358 ! | . | 359 ! |<------>flo | 360 ! | ^ | 361 ! | |.....|....zdyad 362 ! | | | 363 ! A--------|-----D 364 365 zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl)) 366 zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1)) 367 368 ! Translation of this distances (in meter) in indexes 369 370 tpifl(jfl) = (iimfl(jfl)-0.5)+zdxab/ e1u(iimfl(jfl)-1,ijmfl(jfl))+(mig(1)-jpizoom) 371 tpjfl(jfl) = (ijmfl(jfl)-0.5)+zdyad/ e2v(iimfl(jfl),ijmfl(jfl)-1)+(mjg(1)-jpjzoom) 372 tpkfl(jfl) = (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl))*(ikmfl(jfl)) & 373 / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) & 374 + (flzz(jfl) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)))*(ikmfl(jfl)+1) & 375 / (fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl))) 376 ELSE 377 tpifl (jfl) = 0.e0 378 tpjfl (jfl) = 0.e0 379 tpkfl (jfl) = 0.e0 380 idomfl(jfl) = 0 381 ENDIF 382 END DO 320 383 321 ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats. 322 IF( lk_mpp ) CALL mpp_sum( tpifl , jpnfl ) ! sums over the global domain 323 IF( lk_mpp ) CALL mpp_sum( tpjfl , jpnfl ) 324 IF( lk_mpp ) CALL mpp_sum( tpkfl , jpnfl ) 325 IF( lk_mpp ) CALL mpp_sum( idomfl, jpnfl ) 384 ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats. 385 IF( lk_mpp ) CALL mpp_sum( tpifl , jpnfl ) ! sums over the global domain 386 IF( lk_mpp ) CALL mpp_sum( tpjfl , jpnfl ) 387 IF( lk_mpp ) CALL mpp_sum( tpkfl , jpnfl ) 388 IF( lk_mpp ) CALL mpp_sum( idomfl, jpnfl ) 389 ENDIF 390 326 391 ENDIF 327 392 -
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 -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r2715 r2839 111 111 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 112 112 INTEGER :: numsol = -1 !: logical unit for solver statistics 113 INTEGER :: numfl = -1 !: logical unit for floats ascii output 113 114 114 115 !!---------------------------------------------------------------------- -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r2715 r2839 19 19 !!-------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE flo_oce ! floats module declarations 21 22 USE lbclnk ! lateal boundary condition / mpp exchanges 22 23 USE iom_def ! iom variables definitions … … 48 49 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 49 50 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 50 PRIVATE iom_p 2d, iom_p3d51 PRIVATE iom_p1d, iom_p2d, iom_p3d 51 52 #if defined key_iomput 52 53 PRIVATE set_grid … … 63 64 END INTERFACE 64 65 INTERFACE iom_put 65 MODULE PROCEDURE iom_p0d, iom_p 2d, iom_p3d66 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 66 67 END INTERFACE 67 68 #if defined key_iomput … … 115 116 CALL event__set_vert_axis( "depthv", gdept_0 ) 116 117 CALL event__set_vert_axis( "depthw", gdepw_0 ) 118 #if defined key_floats 119 CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp) ) 120 #endif 117 121 118 122 ! automatic definitions of some of the xml attributs … … 961 965 #endif 962 966 END SUBROUTINE iom_p0d 967 968 SUBROUTINE iom_p1d( cdname, pfield1d ) 969 CHARACTER(LEN=*) , INTENT(in) :: cdname 970 REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d 971 INTEGER :: jpn 972 #if defined key_iomput 973 CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpn/) ) ) 974 #else 975 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 976 #endif 977 END SUBROUTINE iom_p1d 963 978 964 979 SUBROUTINE iom_p2d( cdname, pfield2d ) -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2715 r2839 341 341 #endif 342 342 ! ! Diagnostics 343 IF( lk_floats ) CALL flo_init ! drifting Floats 343 344 CALL iom_init ! iom_put initialization 344 IF( lk_floats ) CALL flo_init ! drifting Floats345 345 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag 346 346 CALL dia_ptr_init ! Poleward TRansports initialization
Note: See TracChangeset
for help on using the changeset viewer.
