- Timestamp:
- 2014-08-13T10:46:04+02:00 (10 years ago)
- Location:
- branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS
- Files:
-
- 1 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/namelist
r4738 r4739 3 3 cp_cfz = 'antarctic' ! Name of zoom configuration (arctic and antarctic have some special treatment if lzoom=.true.) 4 4 jp_cfg = 2 ! Resolution of the model (used for med_red_seas damping) 5 lzoom = . true.! Zoom configuration or not5 lzoom = .false. ! Zoom configuration or not 6 6 ln_full_field = .false. ! Calculate coefficient over whole of domain 7 7 ln_med_red_seas = .true. ! Damping in Med/Red Seas (or local modifications here if ln_full_field=.true.) 8 ln_old_31_lev_code = .true. ! Replicate behaviour of old online code for 31 level model (Med/Red seas damping based on level number instead of depth) 8 9 ln_coast = .true. ! Reduce near to coastlines 9 10 ln_zero_top_layer = .true. ! No damping in top layer -
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/coast_dist.F90
r4738 r4739 19 19 !! 20 20 IMPLICIT NONE 21 REAL( 8), DIMENSION(jpi,jpj), INTENT( inout ) :: presto22 REAL( 8), DIMENSION(jpi,jpj) :: zdct23 REAL( 8) :: zinfl = 1000.e3! Distance of influence of coast line (could be21 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: presto 22 REAL(wp), DIMENSION(jpi,jpj) :: zdct 23 REAL(wp) :: zinfl = 1000.e3_wp ! Distance of influence of coast line (could be 24 24 ! a namelist setting) 25 25 INTEGER :: jj, ji ! dummy loop indices … … 30 30 DO ji = 1, jpi 31 31 zdct(ji,jj) = MIN( zinfl, zdct(ji,jj) ) 32 presto(ji,jj) = presto(ji, jj) * 0.5 * ( 1.- COS( rpi*zdct(ji,jj)/zinfl) )32 presto(ji,jj) = presto(ji, jj) * 0.5_wp * ( 1._wp - COS( rpi*zdct(ji,jj)/zinfl) ) 33 33 END DO 34 34 END DO … … 57 57 !!---------------------------------------------------------------------- 58 58 !! 59 REAL( 8), DIMENSION(jpi,jpj), INTENT( out ) :: pdct ! distance to the coastline59 REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) :: pdct ! distance to the coastline 60 60 !! 61 61 INTEGER :: ji, jj, jl ! dummy loop indices 62 62 INTEGER :: iju, ijt, icoast, itime, ierr, icot ! local integers 63 63 CHARACTER (len=32) :: clname ! local name 64 REAL( 8) :: zdate0 ! local scalar65 REAL( 8), POINTER, DIMENSION(:,:) :: zxt, zyt, zzt, zmask66 REAL( 8), POINTER, DIMENSION(: ) :: zxc, zyc, zzc, zdis ! temporary workspace64 REAL(wp) :: zdate0 ! local scalar 65 REAL(wp), POINTER, DIMENSION(:,:) :: zxt, zyt, zzt, zmask 66 REAL(wp), POINTER, DIMENSION(: ) :: zxc, zyc, zzc, zdis ! temporary workspace 67 67 LOGICAL , ALLOCATABLE, DIMENSION(:,:) :: llcotu, llcotv, llcotf ! 2D logical workspace 68 68 … … 90 90 CALL check_nf90( nf90_get_var( ncin, fmask_id, fmask, (/ 1,1 /), (/ jpi, jpj /) ) ) 91 91 92 pdct(:,:) = 0. 92 pdct(:,:) = 0._wp 93 93 zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) ) 94 94 zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) ) … … 101 101 zmask(ji,jj) = ( tmask(ji,jj+1) + tmask(ji+1,jj+1) & 102 102 & + tmask(ji,jj ) + tmask(ji+1,jj ) ) 103 llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj ) == 1. )104 llcotv(ji,jj) = ( tmask(ji,jj ) + tmask(ji ,jj+1) == 1. )105 llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4.)103 llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj ) == 1._wp ) 104 llcotv(ji,jj) = ( tmask(ji,jj ) + tmask(ji ,jj+1) == 1._wp ) 105 llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp ) 106 106 END DO 107 107 END DO … … 196 196 DO jj = 1, jpj 197 197 DO ji = 1, jpi 198 IF( tmask(ji,jj) == 0. ) THEN199 pdct(ji,jj) = 0. 198 IF( tmask(ji,jj) == 0._wp ) THEN 199 pdct(ji,jj) = 0._wp 200 200 ELSE 201 201 DO jl = 1, icoast -
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90
r4738 r4739 24 24 USE med_red_seas 25 25 USE zoom 26 USE custom 26 27 27 28 IMPLICIT NONE 28 29 INTEGER :: ji, jj, jk ! dummpy loop variables 29 REAL( 8) :: zsdmp, zbdmp ! Surface and bottom damping coeff30 REAL(wp) :: zsdmp, zbdmp ! Surface and bottom damping coeff 30 31 CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc' ! mesh file 31 CHARACTER(LEN=200) :: outfile = ' dmp_mask.nc' ! output file32 REAL( 8) :: zlat, zlat2, zlat032 CHARACTER(LEN=200) :: outfile = 'resto.nc' ! output file 33 REAL(wp) :: zlat, zlat2, zlat0 33 34 34 35 ! Read namelist … … 55 56 56 57 !Calculate surface and bottom damping coefficients 57 zsdmp = 1. / ( pn_surf * rday )58 zbdmp = 1. / ( pn_bot * rday )58 zsdmp = 1._wp / ( pn_surf * rday ) 59 zbdmp = 1._wp / ( pn_bot * rday ) 59 60 60 61 !Loop through levels and read in tmask for each level as starting point for 61 62 !coefficient array 62 63 DO jk = 1, jpk-1 63 resto(:,:) = 0. 64 resto(:,:) = 0._wp 64 65 65 66 IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN … … 83 84 zlat = ABS(gphit(ji,jj)) 84 85 IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN 85 resto(ji,jj) = resto(ji,jj) * 0.5 * ( 1.- COS( rpi*(zlat-nn_hdmp)/zlat0 ) )86 resto(ji,jj) = resto(ji,jj) * 0.5_wp * ( 1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) ) 86 87 ELSE IF ( zlat < nn_hdmp ) THEN 87 resto(ji,jj) = 0. 88 resto(ji,jj) = 0._wp 88 89 ENDIF 89 90 END DO … … 98 99 99 100 ! Damping in Med/Red Seas (or local modifications if full field is set) 100 IF (ln_med_red_seas .AND. (cp_cfg == 'orca') ) THEN101 CALL med_red_dmp(resto )101 IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN 102 CALL med_red_dmp(resto, jk, ln_old_31_lev_code) 102 103 ENDIF 103 104 … … 105 106 CALL dtacof_zoom(resto, tmask) 106 107 ENDIF 107 108 109 !Any user modifications can be added in the custom module 110 IF ( ln_custom ) THEN 111 CALL custom_resto( resto ) 112 ENDIF 108 113 ENDIF 109 114 -
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/med_red_seas.F90
r4738 r4739 8 8 CONTAINS 9 9 10 SUBROUTINE med_red_dmp(presto )10 SUBROUTINE med_red_dmp(presto, jk, ln_31_lev) 11 11 !!------------------------------------ 12 12 !! **ROUTINE: med_red_dmp … … 17 17 !!----------------------------------- 18 18 INTEGER :: ij0,ij1,ii0,ii1,ji,jj 19 REAL(8), DIMENSION(:,:), ALLOCATABLE :: zmrs 20 REAL(8) :: zhfac, zsdmp, zbdmp 21 REAL(8), DIMENSION(jpi,jpj), INTENT(inout) :: presto 19 INTEGER, INTENT(in) :: jk 20 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmrs 21 REAL(wp) :: zhfac, zsdmp, zbdmp 22 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto 23 LOGICAL, INTENT(in), OPTIONAL :: ln_31_lev 24 LOGICAL :: l_31_lev 22 25 23 26 WRITE(numout,*) 'ORCA Med and Red Seas Damping' 24 27 28 IF ( PRESENT(ln_31_lev)) THEN 29 l_31_lev = ln_31_lev 30 ELSE 31 l_31_lev = .false. 32 ENDIF 33 25 34 ALLOCATE( zmrs(jpi, jpj) ) 26 35 ! 27 zmrs(:,:) = 0. 36 zmrs(:,:) = 0._wp 28 37 ! 29 38 SELECT CASE ( jp_cfg ) … … 43 52 ! ! ======================= 44 53 ij0 = 96 ; ij1 = 110 ! Mediterranean Sea 45 ii0 = 157 ; ii1 = 181 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 54 ii0 = 157 ; ii1 = 181 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 46 55 ij0 = 100 ; ij1 = 110 47 ii0 = 144 ; ii1 = 156 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 56 ii0 = 144 ; ii1 = 156 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 48 57 ij0 = 100 ; ij1 = 103 49 ii0 = 139 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 58 ii0 = 139 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 50 59 ! 51 60 ij0 = 101 ; ij1 = 102 ! Decrease before Gibraltar Strait 52 ii0 = 139 ; ii1 = 141 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0. 53 ii0 = 142 ; ii1 = 142 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. / 90.54 ii0 = 143 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40 55 ii0 = 144 ; ii1 = 144 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75 61 ii0 = 139 ; ii1 = 141 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp 62 ii0 = 142 ; ii1 = 142 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp 63 ii0 = 143 ; ii1 = 143 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp 64 ii0 = 144 ; ii1 = 144 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp 56 65 ! 57 66 ij0 = 87 ; ij1 = 96 ! Red Sea 58 ii0 = 147 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 67 ii0 = 147 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 59 68 ! 60 69 ij0 = 91 ; ij1 = 91 ! Decrease before Bab el Mandeb Strait 61 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.80 70 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp 62 71 ij0 = 90 ; ij1 = 90 63 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40 72 ii0 = 153 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp 64 73 ij0 = 89 ; ij1 = 89 65 ii0 = 158 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. / 90.74 ii0 = 158 ; ii1 = 160 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp 66 75 ij0 = 88 ; ij1 = 88 67 ii0 = 160 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0. 76 ii0 = 160 ; ii1 = 163 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp 68 77 ! 69 78 ! ! ======================= … … 71 80 ! ! ======================= 72 81 ii0 = 568 ; ii1 = 574 ! Mediterranean Sea 73 ij0 = 324 ; ij1 = 333 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 82 ij0 = 324 ; ij1 = 333 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 74 83 ii0 = 575 ; ii1 = 658 75 ij0 = 314 ; ij1 = 366 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 84 ij0 = 314 ; ij1 = 366 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 76 85 ! 77 86 ii0 = 641 ; ii1 = 651 ! Black Sea (remaining part 78 ij0 = 367 ; ij1 = 372 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 87 ij0 = 367 ; ij1 = 372 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 79 88 ! 80 89 ij0 = 324 ; ij1 = 333 ! Decrease before Gibraltar Strait 81 ii0 = 565 ; ii1 = 565 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. / 90.82 ii0 = 566 ; ii1 = 566 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40 83 ii0 = 567 ; ii1 = 567 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75 90 ii0 = 565 ; ii1 = 565 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp 91 ii0 = 566 ; ii1 = 566 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp 92 ii0 = 567 ; ii1 = 567 ; zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp 84 93 ! 85 94 ii0 = 641 ; ii1 = 665 ! Red Sea 86 ij0 = 270 ; ij1 = 310 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1. 95 ij0 = 270 ; ij1 = 310 ; zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp 87 96 ! 88 97 ii0 = 666 ; ii1 = 675 ! Decrease before Bab el Mandeb Strait 89 98 ij0 = 270 ; ij1 = 290 90 99 DO ji = ii0, ii1 91 zmrs( ji , ij0:ij1 ) = 0.1 * ABS( FLOAT(ji - ii1) )100 zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) ) 92 101 END DO 93 102 ! ! ======================== … … 100 109 END SELECT 101 110 102 ! Note that the original "online" code had a dependency on model levels 103 ! here (as opposed to depth) 104 ! This has been removed but can be reproduced using the "custom" module 105 ! if required 106 zsdmp = 1. / ( pn_surf * rday ) 107 zbdmp = 1. / ( pn_bot * rday ) 108 zhfac = ( zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep ) ) 111 zsdmp = 1._wp / ( pn_surf * rday ) 112 zbdmp = 1._wp / ( pn_bot * rday ) 109 113 110 presto(:,:) = zmrs(:,:) * zhfac + ( 1. - zmrs(:,:) ) * presto(:,:) 114 ! The l_31_lev option is used to reproduce the old behaviour of 115 ! defining the restoration coefficient based on the level number. 116 ! This is included to allow damping coefficients for reference 117 ! configurations to be kept the same. 118 IF (l_31_lev) THEN 119 IF (jk <= 17) THEN 120 zhfac = 0.5_wp * ( 1. - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday 121 ELSE 122 zhfac = 1._wp / rday 123 ENDIF 124 ELSE 125 zhfac = ( zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep ) ) 126 ENDIF 127 128 presto(:,:) = zmrs(:,:) * zhfac + ( 1._wp - zmrs(:,:) ) * presto(:,:) 111 129 112 130 DEALLOCATE( zmrs ) -
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/utils.F90
r4738 r4739 6 6 PUBLIC 7 7 8 INTEGER, PUBLIC, PARAMETER :: dp=8 , sp=4, wp=dp 8 9 INTEGER :: tmask_id, umask_id, vmask_id, fmask_id 9 10 INTEGER :: gdept_id … … 13 14 INTEGER :: jpi, jpj, jpk ! Size of domain 14 15 INTEGER :: ncin, ncout ! File handles for netCDF files 15 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: gphit, glamt16 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: gphiu, glamu17 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: gphiv, glamv18 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: gphif, glamf19 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask, fmask20 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: gdept21 REAL( 8), DIMENSION(:,:), ALLOCATABLE :: resto16 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphit, glamt 17 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphiu, glamu 18 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphiv, glamv 19 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gphif, glamf 20 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmask, umask, vmask, fmask 21 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gdept 22 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: resto 22 23 23 24 INTEGER,PARAMETER :: numout = 6 24 25 INTEGER,PARAMETER :: numerr = 0 25 26 INTEGER,PARAMETER :: numnam = 11 26 REAL( 8),PARAMETER :: rday = 86400 ! seconds in a day27 REAL( 8),PARAMETER :: rpi = 3.14159265358979328 REAL( 8),PARAMETER :: rad = 3.141592653589793/180.29 REAL( 8),PARAMETER :: ra = 6371229.27 REAL(wp),PARAMETER :: rday = 86400 ! seconds in a day 28 REAL(wp),PARAMETER :: rpi = 3.141592653589793 29 REAL(wp),PARAMETER :: rad = 3.141592653589793/180. 30 REAL(wp),PARAMETER :: ra = 6371229. 30 31 31 32 ! Namelist variables … … 42 43 LOGICAL :: ln_full_field = .true. 43 44 LOGICAL :: ln_med_red_seas = .false. 45 LOGICAL :: ln_old_31_lev_code = .false. 44 46 LOGICAL :: ln_zero_top_layer = .false. 45 47 LOGICAL :: ln_custom = .false. 46 48 47 49 NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, & 48 ln_med_red_seas, ln_coast, ln_zero_top_layer, ln_custom, & 50 ln_med_red_seas, ln_old_31_lev_code, ln_coast, & 51 ln_zero_top_layer, ln_custom, & 49 52 pn_surf, pn_bot, pn_dep, nn_hdmp, jperio 50 53 … … 106 109 CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) ) 107 110 108 CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_ float, (/id_x,id_y,id_z/), resto_id ) )111 CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) ) 109 112 CALL check_nf90( nf90_enddef(ncout) ) 110 113 -
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90
r4738 r4739 18 18 !! ** Action : - resto, the damping coeff. for T and S 19 19 !!---------------------------------------------------------------------- 20 REAL( 8), DIMENSION(jpi,jpj), INTENT(inout) :: presto ! restoring coeff. (s-1)21 REAL( 8), DIMENSION(jpi,jpj), INTENT(in) :: mask ! restoring coeff. (s-1)20 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto ! restoring coeff. (s-1) 21 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: mask ! restoring coeff. (s-1) 22 22 ! 23 23 INTEGER :: ji, jj, jn ! dummy loop indices 24 REAL(8) :: zlat, zlat0, zlat1, zlat2, z1_5d ! local scalar 25 REAL(8), DIMENSION(6) :: zfact ! 1Dworkspace 24 REAL(wp) :: zlat, zlat0, zlat1, zlat2, z1_5d ! local scalar 25 REAL(wp), DIMENSION(6) :: zfact ! 1Dworkspace 26 27 !Namelist variables 28 LOGICAL :: lzoom_w, lzoom_e, lzoom_n, lzoom_s 29 NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s 26 30 !!---------------------------------------------------------------------- 27 31 ! … … 29 33 ! 30 34 35 ! Read namelist 36 OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' ) 37 READ( numnam, nam_dmp_create ) 38 CLOSE( numnam ) 31 39 32 zfact(1) = 1. 33 zfact(2) = 1. 34 zfact(3) = 11. / 12.35 zfact(4) = 8. / 12.36 zfact(5) = 4. / 12.37 zfact(6) = 1. / 12.38 zfact(:) = zfact(:) / ( 5. * rday ) ! 5 days max restoring time scale40 zfact(1) = 1._wp 41 zfact(2) = 1._wp 42 zfact(3) = 11._wp / 12._wp 43 zfact(4) = 8._wp / 12._wp 44 zfact(5) = 4._wp / 12._wp 45 zfact(6) = 1._wp / 12._wp 46 zfact(:) = zfact(:) / ( 5._wp * rday ) ! 5 days max restoring time scale 39 47 40 presto(:,:) = 0. 48 presto(:,:) = 0._wp 41 49 42 50 ! damping along the forced closed boundary over 6 grid-points … … 51 59 IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN ! ORCA configuration : arctic or antarctic zoom 52 60 ! ! ==================================================== 53 IF(lwp)WRITE(numout,*)54 IF( lwp .AND.cp_cfz == "arctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Arctic zoom'55 IF( lwp .AND.cp_cfz == "antarctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Antarctic zoom'56 IF(lwp)WRITE(numout,*)61 WRITE(numout,*) 62 IF(cp_cfz == "arctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Arctic zoom' 63 IF(cp_cfz == "antarctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Antarctic zoom' 64 WRITE(numout,*) 57 65 ! 58 66 ! ! Initialization : 59 presto(:,:) = 0. 60 zlat0 = 10. ! zlat0 : latitude strip where resto decreases61 zlat1 = 30. ! zlat1 : resto = 1 before zlat167 presto(:,:) = 0._wp 68 zlat0 = 10._wp ! zlat0 : latitude strip where resto decreases 69 zlat1 = 30._wp ! zlat1 : resto = 1 before zlat1 62 70 zlat2 = zlat1 + zlat0 ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2 63 z1_5d = 1. / ( 5.* rday ) ! z1_5d : 1 / 5days71 z1_5d = 1._wp / ( 5._wp * rday ) ! z1_5d : 1 / 5days 64 72 65 73 DO jj = 1, jpj … … 67 75 zlat = ABS( gphit(ji,jj) ) 68 76 IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN 69 presto(ji,jj) = 0.5 * z1_5d * ( 1.- COS( rpi*(zlat2-zlat)/zlat0 ) )77 presto(ji,jj) = 0.5_wp * z1_5d * ( 1._wp - COS( rpi*(zlat2-zlat)/zlat0 ) ) 70 78 ELSEIF( zlat < zlat1 ) THEN 71 79 presto(ji,jj) = z1_5d
Note: See TracChangeset
for help on using the changeset viewer.