Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r2715 r3294 14 14 !! 3.2 ! 2009-08 (G. Madec, C. Talandier) DOCTOR norm for namelist parameter 15 15 !! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC 16 !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 16 17 !!---------------------------------------------------------------------- 17 #if defined key_tradmp || defined key_esopa 18 !!---------------------------------------------------------------------- 19 !! 'key_tradmp' internal damping 18 20 19 !!---------------------------------------------------------------------- 21 20 !! tra_dmp_alloc : allocate tradmp arrays … … 32 31 USE zdf_oce ! ocean: vertical physics 33 32 USE phycst ! physical constants 34 USE dtatem ! data: temperature 35 USE dtasal ! data: salinity 33 USE dtatsd ! data: temperature & salinity 36 34 USE zdfmxl ! vertical physics: mixed layer depth 37 35 USE in_out_manager ! I/O manager 38 36 USE lib_mpp ! MPP library 39 37 USE prtctl ! Print control 38 USE wrk_nemo ! Memory allocation 39 USE timing ! Timing 40 40 41 41 IMPLICIT NONE … … 47 47 PUBLIC dtacof_zoom ! routine called by in both tradmp.F90 and trcdmp.F90 48 48 49 #if ! defined key_agrif 50 LOGICAL, PUBLIC, PARAMETER :: lk_tradmp = .TRUE. !: internal damping flag 51 #else 52 LOGICAL, PUBLIC :: lk_tradmp = .TRUE. !: internal damping flag 53 #endif 49 ! !!* Namelist namtra_dmp : T & S newtonian damping * 50 LOGICAL, PUBLIC :: ln_tradmp = .TRUE. !: internal damping flag 51 INTEGER :: nn_hdmp = -1 ! = 0/-1/'latitude' for damping over T and S 52 INTEGER :: nn_zdmp = 0 ! = 0/1/2 flag for damping in the mixed layer 53 REAL(wp) :: rn_surf = 50._wp ! surface time scale for internal damping [days] 54 REAL(wp) :: rn_bot = 360._wp ! bottom time scale for internal damping [days] 55 REAL(wp) :: rn_dep = 800._wp ! depth of transition between rn_surf and rn_bot [meters] 56 INTEGER :: nn_file = 2 ! = 1 create a damping.coeff NetCDF file 57 54 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: strdmp !: damping salinity trend (psu/s) 55 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ttrdmp !: damping temperature trend (Celcius/s) 56 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 57 58 ! !!* Namelist namtra_dmp : T & S newtonian damping *59 INTEGER :: nn_hdmp = -1 ! = 0/-1/'latitude' for damping over T and S60 INTEGER :: nn_zdmp = 0 ! = 0/1/2 flag for damping in the mixed layer61 REAL(wp) :: rn_surf = 50._wp ! surface time scale for internal damping [days]62 REAL(wp) :: rn_bot = 360._wp ! bottom time scale for internal damping [days]63 REAL(wp) :: rn_dep = 800._wp ! depth of transition between rn_surf and rn_bot [meters]64 INTEGER :: nn_file = 2 ! = 1 create a damping.coeff NetCDF file65 61 66 62 !! * Substitutions … … 76 72 INTEGER FUNCTION tra_dmp_alloc() 77 73 !!---------------------------------------------------------------------- 78 !! *** FUNCTION tra_ bbl_alloc ***79 !!---------------------------------------------------------------------- 80 ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) 74 !! *** FUNCTION tra_dmp_alloc *** 75 !!---------------------------------------------------------------------- 76 ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 81 77 ! 82 78 IF( lk_mpp ) CALL mpp_sum ( tra_dmp_alloc ) 83 79 IF( tra_dmp_alloc > 0 ) CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed') 80 ! 84 81 END FUNCTION tra_dmp_alloc 85 82 … … 103 100 !! ** Action : - (ta,sa) tracer trends updated with the damping trend 104 101 !!---------------------------------------------------------------------- 102 ! 105 103 INTEGER, INTENT(in) :: kt ! ocean time-step index 106 104 !! 107 105 INTEGER :: ji, jj, jk ! dummy loop indices 108 REAL(wp) :: zta, zsa ! local scalars 109 !!---------------------------------------------------------------------- 106 REAL(wp) :: zta, zsa ! local scalars 107 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta 108 !!---------------------------------------------------------------------- 109 ! 110 IF( nn_timing == 1 ) CALL timing_start( 'tra_dmp') 111 ! 112 CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta ) 113 ! !== input T-S data at kt ==! 114 CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt 110 115 ! 111 116 SELECT CASE ( nn_zdmp ) !== type of damping ==! … … 115 120 DO jj = 2, jpjm1 116 121 DO ji = fs_2, fs_jpim1 ! vector opt. 117 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )118 zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )122 zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 123 zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 119 124 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 120 125 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 121 strdmp(ji,jj,jk) = zsa ! save the salinitytrend (used in asmtrj)122 ttrdmp(ji,jj,jk) = zta 126 strdmp(ji,jj,jk) = zsa ! save the trend (used in asmtrj) 127 ttrdmp(ji,jj,jk) = zta 123 128 END DO 124 129 END DO … … 130 135 DO ji = fs_2, fs_jpim1 ! vector opt. 131 136 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 132 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )133 zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )137 zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 138 zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 134 139 ELSE 135 140 zta = 0._wp … … 149 154 DO ji = fs_2, fs_jpim1 ! vector opt. 150 155 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 151 zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )152 zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )156 zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 157 zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 153 158 ELSE 154 159 zta = 0._wp … … 173 178 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 174 179 ! 180 CALL wrk_dealloc( jpi, jpj, jpk, jpts, zts_dta ) 181 ! 182 IF( nn_timing == 1 ) CALL timing_stop( 'tra_dmp') 183 ! 175 184 END SUBROUTINE tra_dmp 176 185 … … 184 193 !! ** Method : read the nammbf namelist and check the parameters 185 194 !!---------------------------------------------------------------------- 186 NAMELIST/namtra_dmp/ nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file195 NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 187 196 !!---------------------------------------------------------------------- 188 197 … … 194 203 IF(lwp) THEN ! Namelist print 195 204 WRITE(numout,*) 196 WRITE(numout,*) 'tra_dmp : T and S newtonian damping'205 WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping' 197 206 WRITE(numout,*) '~~~~~~~' 198 207 WRITE(numout,*) ' Namelist namtra_dmp : set damping parameter' 199 WRITE(numout,*) ' T and S damping option nn_hdmp = ', nn_hdmp 200 WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp, '(zoom: forced to 0)' 201 WRITE(numout,*) ' surface time scale (days) rn_surf = ', rn_surf 202 WRITE(numout,*) ' bottom time scale (days) rn_bot = ', rn_bot 203 WRITE(numout,*) ' depth of transition (meters) rn_dep = ', rn_dep 204 WRITE(numout,*) ' create a damping.coeff file nn_file = ', nn_file 208 WRITE(numout,*) ' add a damping termn or not ln_tradmp = ', ln_tradmp 209 WRITE(numout,*) ' T and S damping option nn_hdmp = ', nn_hdmp 210 WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp, '(zoom: forced to 0)' 211 WRITE(numout,*) ' surface time scale (days) rn_surf = ', rn_surf 212 WRITE(numout,*) ' bottom time scale (days) rn_bot = ', rn_bot 213 WRITE(numout,*) ' depth of transition (meters) rn_dep = ', rn_dep 214 WRITE(numout,*) ' create a damping.coeff file nn_file = ', nn_file 215 WRITE(numout,*) 205 216 ENDIF 206 217 207 ! ! allocate tradmp arrays 208 IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 209 210 SELECT CASE ( nn_hdmp ) 211 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only' 212 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp, ' degrees' 213 CASE DEFAULT 214 WRITE(ctmp1,*) ' bad flag value for nn_hdmp = ', nn_hdmp 215 CALL ctl_stop(ctmp1) 216 END SELECT 217 218 SELECT CASE ( nn_zdmp ) 219 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column' 220 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)' 221 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 222 CASE DEFAULT 223 WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 224 CALL ctl_stop(ctmp1) 225 END SELECT 226 227 IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem ) & 228 & CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 229 230 strdmp(:,:,:) = 0._wp ! internal damping salinity trend (used in asmtrj) 231 ttrdmp(:,:,:) = 0._wp 232 ! ! Damping coefficients initialization 233 IF( lzoom ) THEN ; CALL dtacof_zoom( resto ) 234 ELSE ; CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, & 235 & nn_file, 'TRA' , resto ) 218 IF( ln_tradmp ) THEN ! initialization for T-S damping 219 ! 220 IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 221 ! 222 SELECT CASE ( nn_hdmp ) 223 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only' 224 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp, ' degrees' 225 CASE DEFAULT 226 WRITE(ctmp1,*) ' bad flag value for nn_hdmp = ', nn_hdmp 227 CALL ctl_stop(ctmp1) 228 END SELECT 229 ! 230 SELECT CASE ( nn_zdmp ) 231 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column' 232 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)' 233 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 234 CASE DEFAULT 235 WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 236 CALL ctl_stop(ctmp1) 237 END SELECT 238 ! 239 IF( .NOT.ln_tsd_tradmp ) THEN 240 CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 241 CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data 242 ENDIF 243 ! 244 strdmp(:,:,:) = 0._wp ! internal damping salinity trend (used in asmtrj) 245 ttrdmp(:,:,:) = 0._wp 246 ! ! Damping coefficients initialization 247 IF( lzoom ) THEN ; CALL dtacof_zoom( resto ) 248 ELSE ; CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto ) 249 ENDIF 250 ! 236 251 ENDIF 237 252 ! … … 258 273 REAL(wp), DIMENSION(6) :: zfact ! 1Dworkspace 259 274 !!---------------------------------------------------------------------- 275 ! 276 IF( nn_timing == 1 ) CALL timing_start( 'dtacof_zoom') 277 ! 260 278 261 279 zfact(1) = 1._wp … … 309 327 presto(:,:,:) = presto(:,:,:) * tmask(:,:,:) 310 328 ! 329 IF( nn_timing == 1 ) CALL timing_stop( 'dtacof_zoom') 330 ! 311 331 END SUBROUTINE dtacof_zoom 312 332 … … 327 347 USE iom 328 348 USE ioipsl 329 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released330 USE wrk_nemo, ONLY: zhfac => wrk_1d_1, zmrs => wrk_2d_1 , zdct => wrk_3d_1 ! 1D, 2D, 3D workspace331 349 !! 332 350 INTEGER , INTENT(in ) :: kn_hdmp ! damping option … … 344 362 REAL(wp) :: zlat, zlat0, zlat1, zlat2 ! - - 345 363 REAL(wp) :: zsdmp, zbdmp ! - - 346 CHARACTER(len=20) :: cfile 347 !!---------------------------------------------------------------------- 348 349 IF( wrk_in_use(1, 1) .OR. & 350 wrk_in_use(2, 1) .OR. & 351 wrk_in_use(3, 1) ) THEN 352 CALL ctl_stop('dtacof: requested workspace arrays unavailable') ; RETURN 353 ENDIF 364 CHARACTER(len=20) :: cfile 365 REAL(wp), POINTER, DIMENSION(: ) :: zhfac 366 REAL(wp), POINTER, DIMENSION(:,: ) :: zmrs 367 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdct 368 !!---------------------------------------------------------------------- 369 ! 370 IF( nn_timing == 1 ) CALL timing_start('dtacof') 371 ! 372 CALL wrk_alloc( jpk, zhfac ) 373 CALL wrk_alloc( jpi, jpj, zmrs ) 374 CALL wrk_alloc( jpi, jpj, jpk, zdct ) 354 375 ! ! ==================== 355 376 ! ! ORCA configuration : global domain … … 529 550 ELSE ! No damping ! 530 551 ! !--------------------! 531 CALL ctl_stop( 'Choose a correct value of nn_hdmp or DO NOT defined key_tradmp' )552 CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' ) 532 553 ENDIF 533 554 … … 544 565 ENDIF 545 566 ! 546 IF( wrk_not_released(1, 1) .OR. & 547 wrk_not_released(2, 1) .OR. & 548 wrk_not_released(3, 1) ) CALL ctl_stop('dtacof: failed to release workspace arrays') 567 CALL wrk_dealloc( jpk, zhfac) 568 CALL wrk_dealloc( jpi, jpj, zmrs ) 569 CALL wrk_dealloc( jpi, jpj, jpk, zdct ) 570 ! 571 IF( nn_timing == 1 ) CALL timing_stop('dtacof') 549 572 ! 550 573 END SUBROUTINE dtacof … … 572 595 !!---------------------------------------------------------------------- 573 596 USE ioipsl ! IOipsl librairy 574 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released575 USE wrk_nemo, ONLY: zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4576 597 !! 577 598 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pdct ! distance to the coastline … … 581 602 CHARACTER (len=32) :: clname ! local name 582 603 REAL(wp) :: zdate0 ! local scalar 583 LOGICAL , ALLOCATABLE, DIMENSION(:,:) :: llcotu, llcotv, llcotf ! 2D logical workspace584 REAL(wp), ALLOCATABLE, DIMENSION(:) ::zxc, zyc, zzc, zdis ! temporary workspace585 !!----------------------------------------------------------------------586 587 IF( wrk_in_use(2, 1,2,3,4) .OR. &588 wrk_in_use(1, 1,2,3,4) ) THEN589 CALL ctl_stop('cofdis: requested workspace arrays unavailable') ; RETURN590 ENDIF591 592 ALLOCATE( llcotu(jpi,jpj) , llcotv(jpi,jpj) , llcotf(jpi,jpj) , &593 & zxc (3*jpi*jpj) , zyc (3*jpi*jpj) , zzc (3*jpi*jpj) , zdis (3*jpi*jpj) , STAT=ierr )604 REAL(wp), POINTER, DIMENSION(:,:) :: zxt, zyt, zzt, zmask 605 REAL(wp), POINTER, DIMENSION(: ) :: zxc, zyc, zzc, zdis ! temporary workspace 606 LOGICAL , ALLOCATABLE, DIMENSION(:,:) :: llcotu, llcotv, llcotf ! 2D logical workspace 607 !!---------------------------------------------------------------------- 608 ! 609 IF( nn_timing == 1 ) CALL timing_start('cofdis') 610 ! 611 CALL wrk_alloc( jpi, jpj , zxt, zyt, zzt, zmask ) 612 CALL wrk_alloc( 3*jpi*jpj, zxc, zyc, zzc, zdis ) 613 ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj) ) 614 ! 594 615 IF( lk_mpp ) CALL mpp_sum( ierr ) 595 616 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'cofdis: requested local arrays unavailable') … … 745 766 CALL restclo( icot ) 746 767 ! 747 IF( wrk_not_released(2, 1,2,3,4) .OR. & 748 wrk_not_released(1, 1,2,3,4) ) CALL ctl_stop('cofdis: failed to release workspace arrays') 749 DEALLOCATE( llcotu , llcotv , llcotf , & 750 & zxc , zyc , zzc , zdis ) 768 CALL wrk_dealloc( jpi, jpj , zxt, zyt, zzt, zmask ) 769 CALL wrk_dealloc( 3*jpi*jpj, zxc, zyc, zzc, zdis ) 770 DEALLOCATE( llcotu, llcotv, llcotf ) 771 ! 772 IF( nn_timing == 1 ) CALL timing_stop('cofdis') 751 773 ! 752 774 END SUBROUTINE cofdis 753 754 #else755 !!----------------------------------------------------------------------756 !! Default key NO internal damping757 !!----------------------------------------------------------------------758 LOGICAL , PUBLIC, PARAMETER :: lk_tradmp = .FALSE. !: internal damping flag759 CONTAINS760 SUBROUTINE tra_dmp( kt ) ! Empty routine761 WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt762 END SUBROUTINE tra_dmp763 SUBROUTINE tra_dmp_init ! Empty routine764 END SUBROUTINE tra_dmp_init765 #endif766 767 775 !!====================================================================== 768 776 END MODULE tradmp
Note: See TracChangeset
for help on using the changeset viewer.
