Changeset 3559 for branches/2012/dev_r3438_LOCEAN15_PISLOB
- Timestamp:
- 2012-11-15T11:18:04+01:00 (11 years ago)
- Location:
- branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 3 edited
-
cyclone.F90 (modified) (10 diffs)
-
fldread.F90 (modified) (2 diffs)
-
sbcblk_core.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
r3556 r3559 21 21 USE in_out_manager ! I/O manager 22 22 USE geo2ocean ! tools for projection on ORCA grid 23 USE wrk_nemo ! work arrays 23 24 USE lib_mpp 24 25 … … 46 47 CONTAINS 47 48 48 SUBROUTINE wnd_cyc( kt, pwnd_i, pwnd_j , ptmask_tc)49 SUBROUTINE wnd_cyc( kt, pwnd_i, pwnd_j ) 49 50 !!---------------------------------------------------------------------- 50 51 !! *** ROUTINE wnd_cyc *** … … 58 59 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: pwnd_i ! wind speed i-components at T-point ORCA direction 59 60 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: pwnd_j ! wind speed j-components at T-point ORCA direction 60 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: ptmask_tc ! mask = 1 where TC are added 61 ! add Manu ! 62 61 ! 63 62 !! 64 63 INTEGER :: ji, jj , jtc ! loop arguments … … 80 79 REAL(wp) :: zrmw ! mean radius of Max wind of a tropical cyclone (Willoughby 2004) [m] 81 80 REAL(wp) :: zwnd_r, zwnd_t ! radial and tangential components of the wind 82 REAL(wp), DIMENSION(jpi,jpj) :: zwnd_x, zwnd_y ! zonal and meridional components of the wind 83 81 REAL(wp) :: zvmax ! timestep interpolated vmax 82 REAL(wp) :: zrlon, zrlat ! temporary 83 REAL(wp), DIMENSION(:,:), POINTER :: zwnd_x, zwnd_y ! zonal and meridional components of the wind 84 84 REAL(wp), DIMENSION(14,5) :: ztct ! tropical cyclone track data at kt 85 REAL(wp) :: zvmax ! timestep interpolated vmax 86 REAL(wp) :: zrlon, zrlat ! temporary 87 !! 85 ! 88 86 CHARACTER(len=100) :: cn_dir ! Root directory for location of files 89 87 TYPE(FLD_N), DIMENSION(1) :: slf_i ! array of namelist informations on the TC position … … 92 90 !!-------------------------------------------------------------------- 93 91 92 CALL wrk_alloc( jpi,jpj, zwnd_x, zwnd_y ) 94 93 95 94 ! ! ====================== ! … … 113 112 ENDIF 114 113 ALLOCATE( sf(1)%fnow(14,5,1) ) 115 ALLOCATE( sf(1)%fdta(14,5, 2,1) )114 ALLOCATE( sf(1)%fdta(14,5,1,2) ) 116 115 slf_i(1) = sn_tc 117 116 ! … … 135 134 zwnd_y(:,:) = 0.e0 136 135 137 ptmask_tc(:,:) = 0.e0138 ! add Manu !139 140 136 DO jtc = 1, 14 141 137 ! … … 202 198 zwnd_x(ji,jj) = zwnd_x(ji,jj) - zhemi * COS(ztheta)*zwnd_t + SIN(ztheta)*zwnd_r 203 199 zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r 204 205 ptmask_tc(ji,jj) = 1. !MAX( 1., ptmask_tc(ji,jj) )206 ! add Manu !207 208 209 200 ENDIF 210 201 END DO … … 273 264 zwnd_y(ji,jj) = zwnd_y(ji,jj) + zhemi * SIN(ztheta)*zwnd_t + COS(ztheta)*zwnd_r 274 265 275 ptmask_tc(ji,jj) = 1. !MAX( 1., ptmask_tc(ji,jj) )276 ! add Manu !277 278 266 ENDIF 279 267 END DO … … 286 274 CALL rot_rep ( zwnd_x, zwnd_y, 'T', 'en->j', pwnd_j ) !rotation of components on ORCA grid 287 275 276 CALL wrk_dealloc( jpi,jpj, zwnd_x, zwnd_y ) 288 277 289 278 END SUBROUTINE wnd_cyc -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r3556 r3559 627 627 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 628 628 !! 629 INTEGER :: ipi ! number of i-point sdjf%fdta630 629 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 631 630 INTEGER :: iw ! index into wgts array 632 !!---------------------------------------------------------------------633 634 ipi = SIZE( sdjf%fnow, 1 )631 INTEGER :: ipdom ! index of the domain 632 !!--------------------------------------------------------------------- 633 ! 635 634 ipk = SIZE( sdjf%fnow, 3 ) 636 635 ! 637 636 IF( PRESENT(map) ) THEN 638 637 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) … … 645 644 ENDIF 646 645 ELSE 646 IF( SIZE(sdjf%fdta, 1) == jpi ) THEN ; ipdom = jpdom_data 647 ELSE ; ipdom = jpdom_unknown 648 ENDIF 647 649 SELECT CASE( ipk ) 648 CASE(1) 649 IF( ipi == jpi ) THEN 650 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 651 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 652 ENDIF 653 ELSE 654 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 655 ELSE ; CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 656 ENDIF 650 CASE(1) 651 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 652 ELSE ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 657 653 ENDIF 658 654 CASE DEFAULT 659 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )660 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) )655 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 656 ELSE ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) ) 661 657 ENDIF 662 658 END SELECT -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3556 r3559 235 235 REAL(wp) :: zcoef_qsatw, zztmp ! local variable 236 236 REAL(wp), DIMENSION(:,:), POINTER :: zwnd_i, zwnd_j ! wind speed components at T-point 237 #if defined key_cyclone238 REAL(wp), DIMENSION(:,:), POINTER :: ztmask_tc ! mask = 1 where TC are added239 REAL(wp), DIMENSION(:,:), POINTER :: ztcmask_qns ! total non-solar heat flux within TC footprints240 REAL(wp), DIMENSION(:,:), POINTER :: ztcmask_qnsneg ! negative part of non-solar heat flux within TC footprints241 #endif242 237 REAL(wp), DIMENSION(:,:), POINTER :: zqsatw ! specific humidity at pst 243 238 REAL(wp), DIMENSION(:,:), POINTER :: zqlw, zqsb ! long wave and sensible heat fluxes … … 268 263 zwnd_i(:,:) = 0.e0 269 264 zwnd_j(:,:) = 0.e0 270 271 265 #if defined key_cyclone 272 CALL wrk_alloc( jpi, jpj, ztmask_tc, ztcmask_qns, ztcmask_qnsneg )273 266 # if defined key_vectopt_loop 274 267 !CDIR COLLAPSE 275 268 # endif 276 CALL wnd_cyc( kt, zwnd_i, zwnd_j , ztmask_tc) ! add Manu !269 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add Manu ! 277 270 DO jj = 2, jpjm1 278 271 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 282 275 END DO 283 276 #endif 284 285 277 #if defined key_vectopt_loop 286 278 !CDIR COLLAPSE … … 411 403 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 412 404 ! 413 #if defined key_cyclone414 ztcmask_qns(:,:) = qns(:,:) * ztmask_tc(:,:)415 ztcmask_qnsneg(:,:) = MIN( qns(:,:) , 0.e0 ) * ztmask_tc(:,:) ! MAX/MIN sur tableau 2D ??416 CALL iom_put( "qns_tcmask", ztcmask_qns ) ! output downward non solar heat over the ocean within TC footprints417 CALL iom_put( "qns_tcneg", ztcmask_qnsneg ) ! output downward non solar heat over the ocean negative part only418 CALL wrk_dealloc( jpi, jpj, ztmask_tc, ztcmask_qns, ztcmask_qnsneg )419 #endif420 405 IF(ln_ctl) THEN 421 406 CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce_core: zqsb : ', tab2d_2=zqlw , clinfo2=' zqlw : ')
Note: See TracChangeset
for help on using the changeset viewer.
