Changeset 2907 for branches/2011/dev_r2802_MERCATOR9_floats
- Timestamp:
- 2011-10-12T19:08:14+02:00 (13 years ago)
- Location:
- branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO
- Files:
-
- 5 edited
-
flo4rk.F90 (modified) (2 diffs)
-
floats.F90 (modified) (1 diff)
-
flodom.F90 (modified) (12 diffs)
-
florst.F90 (modified) (6 diffs)
-
flowri.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r2839 r2907 52 52 !! 53 53 INTEGER :: jfl, jind ! dummy loop indices 54 INTEGER :: ierror ! error value 55 54 56 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions 55 57 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position … … 57 59 !!--------------------------------------------------------------------- 58 60 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) ) 61 ALLOCATE ( zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl) , & 62 zufl(jpnfl) , zvfl(jpnfl) , zwfl(jpnfl) , & 63 zrkxfl(jpnfl,4), zrkyfl(jpnfl,4), zrkzfl(jpnfl,4) , STAT=ierror ) 64 ! 65 IF( ierror /= 0 ) THEN 66 WRITE(numout,*) 'flo_4rk: allocation of workspace arrays failed' 67 ENDIF 68 62 69 63 70 IF( kt == nit000 ) THEN -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r2843 r2907 102 102 IF( flo_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_init : unable to allocate arrays' ) 103 103 ! 104 ! ! allocate flodom arrays 105 IF( flo_dom_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_dom : unable to allocate arrays' ) 106 ! 104 107 ! ! allocate flowri arrays 105 108 IF( flo_wri_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_wri : unable to allocate arrays' ) 109 ! 110 ! ! allocate florst arrays 111 IF( flo_rst_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'flo_rst : unable to allocate arrays' ) 106 112 ! 107 113 !memory allocation -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r2844 r2907 27 27 PRIVATE 28 28 29 PUBLIC flo_dom ! routine called by floats.F90 29 PUBLIC flo_dom ! routine called by floats.F90 30 PUBLIC flo_dom_alloc ! Routine called in floats.F90 30 31 31 32 CHARACTER (len=21) :: clname1 = 'init_float' ! floats initialisation filename 32 33 CHARACTER (len=21) :: clname2 = 'init_float_ariane' ! ariane floats initialisation filename 34 35 36 INTEGER , ALLOCATABLE, DIMENSION(:) :: iimfl, ijmfl, ikmfl ! index mesh of floats 37 INTEGER , ALLOCATABLE, DIMENSION(:) :: idomfl, ivtest, ihtest ! - 38 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl, zgjfl, zgkfl ! distances in indexes 33 39 34 40 !! * Substitutions … … 89 95 90 96 IF( ln_ariane )THEN !Add new floats with ariane convention 91 CALL add_new_ariane_floats(jpnrstflo+1,jpnfl)97 CALL flo_add_new_ariane_floats(jpnrstflo+1,jpnfl) 92 98 ELSE !Add new floats with long/lat convention 93 CALL add_new_floats(jpnrstflo+1,jpnfl)99 CALL flo_add_new_floats(jpnrstflo+1,jpnfl) 94 100 ENDIF 95 101 ENDIF … … 101 107 102 108 IF( ln_ariane )THEN !Add new floats with ariane convention 103 CALL add_new_ariane_floats(1,jpnfl)109 CALL flo_add_new_ariane_floats(1,jpnfl) 104 110 ELSE !Add new floats with long/lat convention 105 CALL add_new_floats(1,jpnfl)111 CALL flo_add_new_floats(1,jpnfl) 106 112 ENDIF 107 113 … … 110 116 END SUBROUTINE flo_dom 111 117 112 SUBROUTINE add_new_floats(kfl_start, kfl_end)118 SUBROUTINE flo_add_new_floats(kfl_start, kfl_end) 113 119 !! ------------------------------------------------------------- 114 120 !! *** SUBROUTINE add_new_arianefloats *** … … 134 140 LOGICAL :: llinmesh 135 141 CHARACTER(len=80) :: cltmp 136 137 INTEGER , DIMENSION(jpnfl) :: iimfl, ijmfl, ikmfl ! index mesh of floats138 INTEGER , DIMENSION(jpnfl) :: idomfl, ivtest, ihtest ! -139 REAL(wp), DIMENSION(jpnfl) :: zgifl, zgjfl, zgkfl140 142 !!--------------------------------------------------------------------- 141 143 ifl = kfl_end-kfl_start+1 … … 164 166 # endif 165 167 ! For each float we find the indexes of the mesh 166 CALL f indmesh(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)168 CALL flo_findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1), & 169 glamf(ji-1,jj ),gphif(ji-1,jj ), & 170 glamf(ji ,jj ),gphif(ji ,jj ), & 171 glamf(ji ,jj-1),gphif(ji ,jj-1), & 172 flxx(jfl) ,flyy(jfl) , & 173 glamt(ji ,jj ),gphit(ji ,jj ), llinmesh) 172 174 IF( llinmesh )THEN 173 175 iimfl(jfl) = ji … … 231 233 ! A--------|-----D 232 234 ! 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 zdxab = flo_dstnce( flxx(jfl), flyy(jfl), glamf(iimfl(jfl)-1,ijmfl(jfl)-1), flyy(jfl) ) 236 zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) ) 235 237 236 238 ! Translation of this distances (in meter) in indexes … … 277 279 ENDIF 278 280 279 END SUBROUTINE add_new_floats280 281 SUBROUTINE add_new_ariane_floats(kfl_start, kfl_end)281 END SUBROUTINE flo_add_new_floats 282 283 SUBROUTINE flo_add_new_ariane_floats(kfl_start, kfl_end) 282 284 !! ------------------------------------------------------------- 283 285 !! *** SUBROUTINE add_new_arianefloats *** … … 349 351 350 352 351 END SUBROUTINE add_new_ariane_floats352 353 354 SUBROUTINE f indmesh( pax, pay, pbx, pby, &355 pcx, pcy, pdx, pdy, &356 px ,py ,ptx, pty, ldinmesh )353 END SUBROUTINE flo_add_new_ariane_floats 354 355 356 SUBROUTINE flo_findmesh( pax, pay, pbx, pby, & 357 pcx, pcy, pdx, pdy, & 358 px ,py ,ptx, pty, ldinmesh ) 357 359 !! ------------------------------------------------------------- 358 360 !! *** ROUTINE findmesh *** … … 410 412 ENDIF 411 413 ! 412 END SUBROUTINE f indmesh413 414 415 FUNCTION dstnce( pla1, phi1, pla2, phi2 )414 END SUBROUTINE flo_findmesh 415 416 417 FUNCTION flo_dstnce( pla1, phi1, pla2, phi2 ) 416 418 !! ------------------------------------------------------------- 417 419 !! *** Function dstnce *** … … 423 425 REAL(wp), INTENT(in) :: pla1, phi1, pla2, phi2 ! ??? 424 426 !! 425 REAL(wp) :: 426 REAL(wp) :: 427 REAL(wp) :: dly1, dly2, dlx1, dlx2, dlx, dls, dld, dpi 428 REAL(wp) :: flo_dstnce 427 429 !!--------------------------------------------------------------------- 428 430 ! 429 dpi = 2. * ASIN(1.)430 dls = dpi / 180. 431 dpi = 2._wp * ASIN(1._wp) 432 dls = dpi / 180._wp 431 433 dly1 = phi1 * dls 432 434 dly2 = phi2 * dls … … 436 438 dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1) 437 439 ! 438 IF( ABS(dlx) > 1.0 ) dlx = 1.0 439 ! 440 dld = ATAN(DSQRT( 1.d0 * ( 1.-dlx )/( 1.+dlx ) )) * 222.24 / dls 441 dstnce = dld * 1000. 442 ! 443 END FUNCTION dstnce 444 445 446 # else 440 IF( ABS(dlx) > 1.0_wp ) dlx = 1.0_wp 441 ! 442 dld = ATAN(DSQRT( 1._wp * ( 1._wp-dlx )/( 1._wp+dlx ) )) * 222.24_wp / dls 443 flo_dstnce = dld * 1000._wp 444 ! 445 END FUNCTION flo_dstnce 446 447 INTEGER FUNCTION flo_dom_alloc() 448 !!---------------------------------------------------------------------- 449 !! *** FUNCTION flo_dom_alloc *** 450 !!---------------------------------------------------------------------- 451 452 ALLOCATE( iimfl(jpnfl) , ijmfl(jpnfl) , ikmfl(jpnfl) , & 453 idomfl(jpnfl), ivtest(jpnfl), ihtest(jpnfl), & 454 zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl) , STAT=flo_dom_alloc ) 455 ! 456 IF( lk_mpp ) CALL mpp_sum ( flo_dom_alloc ) 457 IF( flo_dom_alloc /= 0 ) CALL ctl_warn('flo_dom_alloc: failed to allocate arrays') 458 END FUNCTION flo_dom_alloc 459 460 461 #else 447 462 !!---------------------------------------------------------------------- 448 463 !! Default option Empty module -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
r2844 r2907 2 2 !!====================================================================== 3 3 !! *** MODULE florst *** 4 !! blablabla: floteur.... 4 !! 5 !! 6 !! write floats restart files 7 !! 5 8 !!====================================================================== 6 9 !! History : … … 24 27 PRIVATE 25 28 26 PUBLIC flo_rst ! routine called by floats.F90 29 PUBLIC flo_rst ! routine called by floats.F90 30 PUBLIC flo_rst_alloc ! routine called by floats.F90 31 32 INTEGER, ALLOCATABLE, DIMENSION(:) :: iperproc ! 1D workspace 27 33 28 34 !! * Substitutions … … 35 41 36 42 CONTAINS 43 44 INTEGER FUNCTION flo_rst_alloc() 45 !!------------------------------------------------------------------- 46 !! *** FUNCTION flo_rst_alloc *** 47 !!------------------------------------------------------------------- 48 ALLOCATE( iperproc(jpnij), STAT=flo_rst_alloc ) 49 ! 50 IF( lk_mpp ) CALL mpp_sum ( flo_rst_alloc ) 51 IF( flo_rst_alloc /= 0 ) CALL ctl_warn('flo_rst_alloc: failed to allocate arrays.') 52 END FUNCTION flo_rst_alloc 53 37 54 38 55 SUBROUTINE flo_rst( kt ) … … 54 71 INTEGER :: ic , jc , jpn ,jfl ! temporary integer 55 72 INTEGER :: inum ! temporary logical unit for restart file 56 INTEGER,DIMENSION(jpnij) :: iproc ! temporary logical57 73 !!---------------------------------------------------------------------- 58 74 … … 85 101 ! 86 102 DO jpn = 1, jpnij 87 ip roc(jpn) = 0103 iperproc(jpn) = 0 88 104 END DO 89 105 ! … … 102 118 &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND. & 103 119 &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 104 ip roc(narea) = iproc(narea)+1120 iperproc(narea) = iperproc(narea)+1 105 121 ENDIF 106 122 END DO 107 CALL mpp_sum( ip roc, jpnij )123 CALL mpp_sum( iperproc, jpnij ) 108 124 ! 109 125 IF(lwp) THEN 110 126 WRITE(numout,*) 'DATE',adatrj 111 127 DO jpn = 1, jpnij 112 IF( ip roc(jpn) /= 0 ) THEN113 WRITE(numout,*)'PROCESSOR',jpn-1,'compute',ip roc(jpn), 'trajectories.'128 IF( iperproc(jpn) /= 0 ) THEN 129 WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iperproc(jpn), 'trajectories.' 114 130 ENDIF 115 131 END DO -
branches/2011/dev_r2802_MERCATOR9_floats/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r2876 r2907 2 2 !!====================================================================== 3 3 !! *** MODULE flowri *** 4 !! blablabla: floteur.... 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 10 !! History : … … 30 34 PRIVATE 31 35 32 PUBLIC flo_wri ! routine called by floats.F9036 PUBLIC flo_wri ! routine called by floats.F90 33 37 PUBLIC flo_wri_alloc ! routine called by floats.F90 34 38 35 INTEGER :: jfl ! number of floats39 INTEGER :: jfl ! number of floats 36 40 CHARACTER (len=80) :: clname ! netcdf output filename 37 41 … … 86 90 REAL(wp) :: zafl,zbfl,zcfl ! temporary real 87 91 REAL(wp) :: ztime ! " 88 !REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11 ! "89 92 90 93 INTEGER, DIMENSION(2) :: icount 91 94 INTEGER, DIMENSION(2) :: istart 92 93 INTEGER, DIMENSION(1) :: ish 94 INTEGER, DIMENSION(2) :: ish2 95 REAL(wp), DIMENSION(jpnfl*jpk) :: zwork ! 1D workspace 95 INTEGER, DIMENSION(1) :: ish 96 INTEGER, DIMENSION(2) :: ish2 96 97 !!---------------------------------------------------------------------- 97 98 … … 137 138 zsal (jfl) = sn(iafloc,ibfloc,icfl) 138 139 zrho (jfl) = (rhd(iafloc,ibfloc,icfl)+1)*rau0 139 140 ELSE ! the float is not inside of current proc's area141 142 zlon(jfl) = 0.143 zlat(jfl) = 0.144 zdep(jfl) = 0.145 ztem(jfl) = 0.146 zsal (jfl) = 0.147 zrho (jfl) = 0.148 140 149 141 ENDIF … … 197 189 !---------------------- 198 190 IF( kt == nn_it000 ) THEN 199 CALL ctl_opn( numfl , 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )191 CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 200 192 irecflo = NINT( (nitend-nn_it000) / FLOAT(nn_writefl) ) 201 WRITE(numfl ,*)cexper,no,irecflo,jpnfl,nn_writefl193 WRITE(numflo,*)cexper,no,irecflo,jpnfl,nn_writefl 202 194 ENDIF 203 195 204 196 !II-1-b Write in ascii file 205 197 !----------------------------- 206 WRITE(numfl ,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp)198 WRITE(numflo,*) zlon,zlat,zdep,nisobfl,ngrpfl,ztem,zsal, FLOAT(ndastp) 207 199 208 200 209 201 !II-1-c Close netcdf file 210 202 !------------------------- 211 IF( kt == nitend ) CLOSE( numfl )203 IF( kt == nitend ) CLOSE( numflo ) 212 204 213 205 ENDIF … … 245 237 clname=TRIM(clname)//".nc" 246 238 247 CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1 /) , numfl )239 CALL fliocrfd( clname , (/ 'ntraj' , 't' /), (/ jpnfl , -1 /) , numflo ) 248 240 249 CALL fliodefv( numfl , 'traj_lon' , (/1,2/), v_t=flio_r8, long_name="Longitude" , units="degrees_east" )250 CALL fliodefv( numfl , 'traj_lat' , (/1,2/), v_t=flio_r8, long_name="Latitude" , units="degrees_north" )251 CALL fliodefv( numfl , 'traj_depth' , (/1,2/), v_t=flio_r8, long_name="Depth" , units="meters" )252 CALL fliodefv( numfl , 'time_counter', (/2/) , v_t=flio_r8, long_name="Time axis" &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" & 253 245 & , units="seconds since start of the run " ) 254 CALL fliodefv( numfl , 'traj_temp' , (/1,2/), v_t=flio_r8, long_name="Temperature" , units="C" )255 CALL fliodefv( numfl , 'traj_salt' , (/1,2/), v_t=flio_r8, long_name="Salinity" , units="PSU" )256 CALL fliodefv( numfl , 'traj_dens' , (/1,2/), v_t=flio_r8, long_name="Density" , units="kg/m3" )257 CALL fliodefv( numfl , 'traj_group' , (/1/) , v_t=flio_r8, long_name="number of the group" , units="no unit" )258 259 CALL flioputv( numfl , 'traj_group' , REAL(ngrpfl,wp) )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) ) 260 252 261 253 ELSE ! Re-open 262 254 263 CALL flioopfd( TRIM(clname), numfl , "WRITE" )255 CALL flioopfd( TRIM(clname), numflo , "WRITE" ) 264 256 265 257 ENDIF … … 270 262 ztime = ( kt-nn_it000 + 1 ) * rdt 271 263 272 CALL flioputv( numfl , 'time_counter', ztime , start=(/irec/) )264 CALL flioputv( numflo , 'time_counter', ztime , start=(/irec/) ) 273 265 274 266 DO jfl = 1, jpnfl … … 277 269 icfl = INT( tpkfl(jfl) ) ! K-index of the nearest point before 278 270 279 CALL flioputv( numfl , 'traj_lon' , zlon(jfl) , start=istart )280 CALL flioputv( numfl , 'traj_lat' , zlat(jfl) , start=istart )281 CALL flioputv( numfl , 'traj_depth' , zdep(jfl) , start=istart )282 CALL flioputv( numfl , 'traj_temp' , ztemp(icfl,jfl) , start=istart )283 CALL flioputv( numfl , 'traj_salt' , zsal(icfl,jfl) , start=istart )284 CALL flioputv( numfl , 'traj_dens' , zrho(icfl,jfl) , start=istart )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 ) 285 277 286 278 ENDDO … … 288 280 !II-2-b-3 Close netcdf file 289 281 !--------------------------- 290 CALL flioclo( numfl )282 CALL flioclo( numflo ) 291 283 292 284 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
