Changeset 2843
- Timestamp:
- 2011-09-19T18:32:43+02:00 (13 years ago)
- Location:
- branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO
- Files:
-
- 3 edited
-
floats.F90 (modified) (1 diff)
-
flodom.F90 (modified) (9 diffs)
-
florst.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r2841 r2843 57 57 IF( lk_mpp ) CALL mppsync ! synchronization of all the processor 58 58 ! 59 CALL flo_wri( kt ) ! trajectories file 59 CALL flo_wri( kt ) ! trajectories ouput 60 ! 61 CALL flo_rst( kt ) ! trajectories restart 60 62 ! 61 63 wb(:,:,:) = wn(:,:,:) ! Save the old vertical velocity field -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r2839 r2843 4 4 !! Ocean floats : domain 5 5 !!====================================================================== 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 6 !! History : OPA ! 1998-07 (Y.Drillet, CLIPPER) Original code 7 !! NEMO_3.3.1 ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 8 ! add Ariane convention, Comsecitc changes 7 9 !!---------------------------------------------------------------------- 8 10 #if defined key_floats || defined key_esopa … … 10 12 !! 'key_floats' float trajectories 11 13 !!---------------------------------------------------------------------- 12 !! flo_dom : initialization of floats 13 !! findmesh : compute index of position 14 !! dstnce : compute distance between face mesh and floats 14 !! flo_dom : initialization of floats 15 !! add_new_floats : add new floats (long/lat/depth) 16 !! add_new_ariane_floats : add new floats with araine convention (i/j/k) 17 !! findmesh : compute index of position 18 !! dstnce : compute distance between face mesh and floats 15 19 !!---------------------------------------------------------------------- 16 20 USE oce ! ocean dynamics and tracers … … 25 29 PUBLIC flo_dom ! routine called by floats.F90 26 30 31 CHARACTER (len=21) :: clname1 = 'init_float' ! floats initialisation filename 32 CHARACTER (len=21) :: clname2 = 'init_float_ariane' ! ariane floats initialisation filename 33 27 34 !! * Substitutions 28 35 # include "domzgr_substitute.h90" … … 43 50 !! the longitude (degree) and the depth (m). 44 51 !!---------------------------------------------------------------------- 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 52 INTEGER, DIMENSION(jpnfl) :: iimfl, ijmfl, ikmfl ! index mesh of floats 53 INTEGER, DIMENSION(jpnfl) :: idomfl, ivtest, ihtest ! - - 54 REAL(wp) :: zdxab, zdyad 55 REAL(wp), DIMENSION(jpnnewflo+1) :: zgifl, zgjfl, zgkfl 52 INTEGER :: jfl ! dummy loop 53 INTEGER :: inum ! logical unit for file read 56 54 !!--------------------------------------------------------------------- 57 55 … … 62 60 IF(lwp) WRITE(numout,*) ' jpnfl = ',jpnfl 63 61 64 IF(ln_rstflo) THEN 62 !-------------------------! 63 ! FLOAT RESTART FILE READ ! 64 !-------------------------! 65 IF( ln_rstflo )THEN 66 65 67 IF(lwp) WRITE(numout,*) ' float restart file read' 66 68 67 69 ! open the restart file 70 !---------------------- 68 71 CALL ctl_opn( inum, 'restart_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 69 72 … … 77 80 78 81 ! if we want a surface drift ( like PROVOR floats ) 79 IF( ln_argo ) THEN 80 DO jfl = 1, jpnrstflo 81 nisobfl(jfl) = 0 82 END DO 83 ENDIF 84 85 IF(lwp) WRITE(numout,*)' flo_dom: END of florstlec' 82 IF( ln_argo ) nisobfl(1:jpnrstflo) = 0 86 83 87 84 ! It is possible to add new floats. 88 IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstflo ',jpnfl,jpnrstflo 89 IF( jpnfl > jpnrstflo ) THEN 90 ! open the init file 91 CALL ctl_opn( inum, 'init_float', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 92 DO jfl = jpnrstflo+1, jpnfl 93 READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),jfl1 94 END DO 95 CLOSE(inum) 96 IF(lwp) WRITE(numout,*)' flodom: END reading init_float file' 85 !--------------------------------- 86 IF( jpnfl > jpnrstflo )THEN 87 88 IF(lwp) WRITE(numout,*) ' add new floats' 89 90 IF( ln_ariane )THEN !Add new floats with ariane convention 91 CALL add_new_ariane_floats(jpnrstflo+1,jpnfl) 92 ELSE !Add new floats with long/lat convention 93 CALL add_new_floats(jpnrstflo+1,jpnfl) 94 ENDIF 95 ENDIF 96 97 !--------------------------------------! 98 ! FLOAT INITILISATION: NO RESTART FILE ! 99 !--------------------------------------! 100 ELSE !ln_rstflo 101 102 IF( ln_ariane )THEN !Add new floats with ariane convention 103 CALL add_new_ariane_floats(1,jpnfl) 104 ELSE !Add new floats with long/lat convention 105 CALL add_new_floats(1,jpnfl) 106 ENDIF 107 108 ENDIF 97 109 98 ! Test to find the grid point coordonate with the geographical position 99 DO jfl = jpnrstflo+1, jpnfl 100 ihtest(jfl) = 0 101 ivtest(jfl) = 0 102 ikmfl(jfl) = 0 110 END SUBROUTINE flo_dom 111 112 SUBROUTINE add_new_floats(kfl_start, kfl_end) 113 !! ------------------------------------------------------------- 114 !! *** SUBROUTINE add_new_arianefloats *** 115 !! 116 !! ** Purpose : 117 !! 118 !! First initialisation of floats 119 !! the initials positions of floats are written in a file 120 !! with a variable to know if it is a isobar float a number 121 !! to identified who want the trajectories of this float and 122 !! an index for the number of the float 123 !! open the init file 124 !! 125 !! ** Method : 126 !!---------------------------------------------------------------------- 127 INTEGER, INTENT(in) :: kfl_start, kfl_end 128 !! 129 INTEGER :: inum ! file unit 130 INTEGER :: jfl,ji, jj, jk ! dummy loop indices 131 INTEGER :: itrash ! trash var for reading 132 INTEGER :: ifl ! number of floats to read 133 REAL(wp) :: zdxab, zdyad 134 LOGICAL :: llinmesh 135 CHARACTER(len=80) :: cltmp 136 137 INTEGER , DIMENSION(jpnfl) :: iimfl, ijmfl, ikmfl ! index mesh of floats 138 INTEGER , DIMENSION(jpnfl) :: idomfl, ivtest, ihtest ! - 139 REAL(wp), DIMENSION(jpnfl) :: zgifl, zgjfl, zgkfl 140 !!--------------------------------------------------------------------- 141 ifl = kfl_end-kfl_start+1 142 143 ! we get the init values 144 !----------------------- 145 CALL ctl_opn( inum , clname1, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 146 DO jfl = kfl_start,kfl_end 147 READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash 148 if(lwp)write(numout,*)'read:',jfl,flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),itrash ; call flush(numout) 149 END DO 150 CLOSE(inum) 151 152 ! Test to find the grid point coordonate with the geographical position 153 !---------------------------------------------------------------------- 154 DO jfl = kfl_start,kfl_end 155 ihtest(jfl) = 0 156 ivtest(jfl) = 0 157 ikmfl(jfl) = 0 103 158 # if defined key_mpp_mpi 104 105 106 # else 107 108 159 DO ji = MAX(nldi,2), nlei 160 DO jj = MAX(nldj,2), nlej ! NO vector opt. 161 # else 162 DO ji = 2, jpi 163 DO jj = 2, jpj ! NO vector opt. 109 164 # endif 110 ! For each float we find the indexes of the mesh 111 CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 112 glamf(ji-1,jj ),gphif(ji-1,jj ), & 113 glamf(ji ,jj ),gphif(ji ,jj ), & 114 glamf(ji ,jj-1),gphif(ji ,jj-1), & 115 flxx(jfl) ,flyy(jfl) , & 116 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 117 IF(llinmesh) THEN 118 iimfl(jfl) = ji 119 ijmfl(jfl) = jj 120 ihtest(jfl) = ihtest(jfl)+1 121 DO jk = 1, jpk-1 122 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 123 ikmfl(jfl) = jk 124 ivtest(jfl) = ivtest(jfl) + 1 125 ENDIF 126 END DO 165 ! For each float we find the indexes of the mesh 166 CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 167 glamf(ji-1,jj ),gphif(ji-1,jj ), & 168 glamf(ji ,jj ),gphif(ji ,jj ), & 169 glamf(ji ,jj-1),gphif(ji ,jj-1), & 170 flxx(jfl) ,flyy(jfl) , & 171 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 172 IF( llinmesh )THEN 173 iimfl(jfl) = ji 174 ijmfl(jfl) = jj 175 ihtest(jfl) = ihtest(jfl)+1 176 DO jk = 1, jpk-1 177 IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN 178 ikmfl(jfl) = jk 179 ivtest(jfl) = ivtest(jfl) + 1 127 180 ENDIF 128 181 END DO 129 END DO130 IF(lwp) WRITE(numout,*)' flo_dom: END findmesh'131 132 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1133 IF( ihtest(jfl) == 0 ) THEN134 iimfl(jfl) = -1135 ijmfl(jfl) = -1136 182 ENDIF 137 183 END DO 184 END DO 185 186 ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1 187 IF( ihtest(jfl) == 0 ) THEN 188 iimfl(jfl) = -1 189 ijmfl(jfl) = -1 190 ENDIF 191 END DO 192 193 !Test if each float is in one and only one proc 194 !---------------------------------------------- 195 IF( lk_mpp ) THEN 196 CALL mpp_sum(ihtest,jpnfl) 197 CALL mpp_sum(ivtest,jpnfl) 198 ENDIF 199 DO jfl = kfl_start,kfl_end 200 201 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 202 WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 203 CALL ctl_stop('STOP',TRIM(cltmp) ) 204 ENDIF 205 IF( (ihtest(jfl) == 0) ) THEN 206 WRITE(cltmp,'(A10,i4.4,A20)' )'THE FLOAT',jfl,' IS IN NO MESH' 207 CALL ctl_stop('STOP',TRIM(cltmp) ) 208 ENDIF 209 END DO 210 211 ! We compute the distance between the float and the face of the mesh 212 !------------------------------------------------------------------- 213 DO jfl = kfl_start,kfl_end 214 215 ! Made only if the float is in the domain of the processor 216 IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 217 218 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 219 idomfl(jfl) = 0 220 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1 221 222 ! Computation of the distance between the float and the faces of the mesh 223 ! zdxab 224 ! . 225 ! B----.---------C 226 ! | . | 227 ! |<------>flo | 228 ! | ^ | 229 ! | |.....|....zdyad 230 ! | | | 231 ! A--------|-----D 232 ! 233 zdxab = dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 234 zdyad = dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 235 236 ! Translation of this distances (in meter) in indexes 237 zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 238 zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 239 zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 240 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 241 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) ) & 242 & + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1)) & 243 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 244 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 245 ELSE 246 zgifl(jfl) = 0.e0 247 zgjfl(jfl) = 0.e0 248 zgkfl(jfl) = 0.e0 249 ENDIF 250 251 END DO 252 253 ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 254 IF( lk_mpp ) THEN 255 CALL mpp_sum( zgjfl, ifl ) ! sums over the global domain 256 CALL mpp_sum( zgkfl, ifl ) 257 ENDIF 138 258 139 ! A zero in the sum of the arrays "ihtest" and "ivtest" 140 # if defined key_mpp_mpi 141 CALL mpp_sum(ihtest,jpnfl) 142 CALL mpp_sum(ivtest,jpnfl) 143 # endif 144 DO jfl = jpnrstflo+1, jpnfl 145 IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN 146 IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH' 147 STOP 148 ENDIF 149 IF( (ihtest(jfl) == 0) ) THEN 150 IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH' 151 STOP 152 ENDIF 153 END DO 154 155 ! We compute the distance between the float and the face of the mesh 156 DO jfl = jpnrstflo+1, jpnfl 157 ! Made only if the float is in the domain of the processor 158 IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN 159 160 ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST 161 162 idomfl(jfl) = 0 163 IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1 164 165 ! Computation of the distance between the float and the faces of the mesh 166 ! zdxab 167 ! . 168 ! B----.---------C 169 ! | . | 170 ! |<------>flo | 171 ! | ^ | 172 ! | |.....|....zdyad 173 ! | | | 174 ! A--------|-----D 175 ! 176 177 zdxab = dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 178 zdyad = dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 179 180 ! Translation of this distances (in meter) in indexes 181 182 zgifl(jfl-jpnrstflo)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 183 zgjfl(jfl-jpnrstflo)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 184 zgkfl(jfl-jpnrstflo) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 185 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 186 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) ) & 187 & + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1)) & 188 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & 189 & - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) 190 ELSE 191 zgifl(jfl-jpnrstflo) = 0.e0 192 zgjfl(jfl-jpnrstflo) = 0.e0 193 zgkfl(jfl-jpnrstflo) = 0.e0 194 ENDIF 195 END DO 196 197 ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats. 198 IF( lk_mpp ) THEN 199 CALL mpp_sum( zgjfl, jpnnewflo ) ! sums over the global domain 200 CALL mpp_sum( zgkfl, jpnnewflo ) 201 IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewflo) 202 IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewflo) 203 IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewflo) 204 ENDIF 205 206 DO jfl = jpnrstflo+1, jpnfl 207 tpifl(jfl) = zgifl(jfl-jpnrstflo) 208 tpjfl(jfl) = zgjfl(jfl-jpnrstflo) 209 tpkfl(jfl) = zgkfl(jfl-jpnrstflo) 210 END DO 211 ENDIF 212 ELSE 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 ' 274 275 ! 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 294 # if defined key_mpp_mpi 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. 300 # endif 301 ! for each float we find the indexes of the mesh 302 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 321 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 329 330 ! 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 342 343 ! 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 383 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 391 ENDIF 392 393 ! Print the initial positions of the floats 259 DO jfl = kfl_start,kfl_end 260 tpifl(jfl) = zgifl(jfl) 261 tpjfl(jfl) = zgjfl(jfl) 262 tpkfl(jfl) = zgkfl(jfl) 263 END DO 264 265 ! WARNING : initial position not in the sea 394 266 IF( .NOT. ln_rstflo ) THEN 395 ! WARNING : initial position not in the sea 396 DO jfl = 1, jpnfl 267 DO jfl = kfl_start,kfl_end 397 268 IF( idomfl(jfl) == 1 ) THEN 398 269 IF(lwp) WRITE(numout,*)'*****************************' … … 406 277 ENDIF 407 278 408 END SUBROUTINE flo_dom 279 END SUBROUTINE add_new_floats 280 281 SUBROUTINE add_new_ariane_floats(kfl_start, kfl_end) 282 !! ------------------------------------------------------------- 283 !! *** SUBROUTINE add_new_arianefloats *** 284 !! 285 !! ** Purpose : 286 !! First initialisation of floats with ariane convention 287 !! 288 !! The indexes are read directly from file (warning ariane 289 !! convention, are refered to 290 !! U,V,W grids - and not T-) 291 !! The isobar advection is managed with the sign of tpkfl ( >0 -> 3D 292 !! advection, <0 -> 2D) 293 !! Some variables are not read, as - gl : time index; 4th 294 !! column 295 !! - transport : transport ; 5th 296 !! column 297 !! and paste in the jtrash var 298 !! At the end, ones need to replace the indexes on T grid 299 !! RMQ : there is no float groups identification ! 300 !! 301 !! 302 !! ** Method : 303 !!---------------------------------------------------------------------- 304 INTEGER, INTENT(in) :: kfl_start, kfl_end 305 !! 306 INTEGER :: inum ! file unit 307 INTEGER :: ierr, ifl 308 INTEGER :: jfl, jfl1 ! dummy loop indices 309 INTEGER :: itrash ! trash var for reading 310 CHARACTER(len=80) :: cltmp 311 312 !!---------------------------------------------------------------------- 313 nisobfl(kfl_start:kfl_end) = 1 ! we assume that by default we want 3D advection 314 315 ifl = kfl_end - kfl_start + 1 ! number of floats to read 316 317 ! we check that the number of floats in the init_file are consistant with the namelist 318 IF( lwp ) THEN 319 320 jfl1=0 321 CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 ) 322 DO WHILE (ierr .GE. 0) 323 jfl1=jfl1+1 324 READ (inum,*, iostat=ierr) 325 END DO 326 CLOSE(inum) 327 IF( (jfl1-1) .NE. ifl )THEN 328 WRITE(cltmp,'(A20,A20,A3,i4.4,A10,i4.4)')"the number of floats in",TRIM(clname2), & 329 " = ",jfl1," is not equal to jfl= ",ifl 330 CALL ctl_stop('STOP',TRIM(cltmp) ) 331 ENDIF 332 333 ENDIF 334 335 ! we get the init values 336 CALL ctl_opn( inum, clname2, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 ) 337 DO jfl = kfl_start, kfl_end 338 READ(inum,*) tpifl(jfl),tpjfl(jfl),tpkfl(jfl),itrash, itrash 339 340 IF ( tpkfl(jfl) .LT. 0. ) nisobfl(jfl) = 0 !set the 2D advection according to init_float 341 ngrpfl(jfl)=jfl 342 END DO 343 344 ! conversion from ariane index to T grid index 345 tpkfl(kfl_start:kfl_end) = abs(tpkfl)-0.5 ! reversed vertical axis 346 tpifl(kfl_start:kfl_end) = tpifl+0.5 347 tpjfl(kfl_start:kfl_end) = tpjfl+0.5 348 349 350 END SUBROUTINE add_new_ariane_floats 409 351 410 352 … … 500 442 END FUNCTION dstnce 501 443 444 502 445 # else 503 446 !!---------------------------------------------------------------------- … … 506 449 CONTAINS 507 450 SUBROUTINE flo_dom ! Empty routine 451 WRITE(*,*) 'flo_dom: : You should not have seen this print! error?' 508 452 END SUBROUTINE flo_dom 509 453 #endif -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
r2839 r2843 68 68 IF(lwp) THEN 69 69 WRITE(numout,*) 70 WRITE(numout,*) 'flo_ wri: write in restart_float file '70 WRITE(numout,*) 'flo_rst : write in restart_float file ' 71 71 WRITE(numout,*) '~~~~~~~ ' 72 72 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
