Changeset 5213 for branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO
- Timestamp:
- 2015-04-15T17:03:58+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO
- Files:
-
- 19 edited
-
LIM_SRC_2/ice_2.F90 (modified) (1 diff)
-
OFF_SRC/nemogcm.F90 (modified) (3 diffs)
-
OPA_SRC/BDY/bdytides.F90 (modified) (1 diff)
-
OPA_SRC/C1D/dyndmp.F90 (modified) (6 diffs)
-
OPA_SRC/DIA/diaar5.F90 (modified) (1 diff)
-
OPA_SRC/DIA/diawri.F90 (modified) (4 diffs)
-
OPA_SRC/DOM/domvvl.F90 (modified) (2 diffs)
-
OPA_SRC/DOM/domzgr.F90 (modified) (4 diffs)
-
OPA_SRC/DOM/phycst.F90 (modified) (1 diff)
-
OPA_SRC/DYN/dynadv_ubs.F90 (modified) (1 diff)
-
OPA_SRC/DYN/dynspg_ts.F90 (modified) (4 diffs)
-
OPA_SRC/DYN/dynvor.F90 (modified) (6 diffs)
-
OPA_SRC/IOM/iom.F90 (modified) (1 diff)
-
OPA_SRC/IOM/prtctl.F90 (modified) (1 diff)
-
OPA_SRC/LDF/ldfdyn_c2d.h90 (modified) (8 diffs)
-
OPA_SRC/SBC/sbcblk_core.F90 (modified) (2 diffs)
-
OPA_SRC/TRA/tradmp.F90 (modified) (4 diffs)
-
TOP_SRC/TRP/trcdmp.F90 (modified) (3 diffs)
-
TOP_SRC/TRP/trcnam_trp.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r4306 r5213 57 57 REAL(wp), PUBLIC :: sangvg, cangvg !: sin and cos of the turning angle for ocean stress 58 58 REAL(wp), PUBLIC :: pstarh !: pstar / 2.0 59 60 ! !!** switch for presence of ice or not 61 REAL(wp), PUBLIC :: rswitch 59 62 60 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r4749 r5213 46 46 USE timing ! Timing 47 47 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 48 USE lbcnfd, ONLY: isendto, nsndto 48 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 49 49 50 50 USE trc … … 594 594 !!---------------------------------------------------------------------- 595 595 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 596 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 596 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. 597 !Mocavero, CMCC) 597 598 !!---------------------------------------------------------------------- 598 599 … … 617 618 !loop over the other north-fold processes to find the processes 618 619 !managing the points belonging to the sxT-dxT range 619 DO jn = jpnij - jpni +1, jpnij 620 IF ( njmppt(jn) == njmppmax ) THEN620 621 DO jn = 1, jpni 621 622 !sxT is the first point (in the global domain) of the jn 622 623 !process 623 sxT = n imppt(jn)624 sxT = nfiimpp(jn, jpnj) 624 625 !dxT is the last point (in the global domain) of the jn 625 626 !process 626 dxT = n imppt(jn) + nlcit(jn) - 1627 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 627 628 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 628 629 nsndto = nsndto + 1 629 isendto(nsndto) = jn630 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN630 isendto(nsndto) = jn 631 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 631 632 nsndto = nsndto + 1 632 isendto(nsndto) = jn633 isendto(nsndto) = jn 633 634 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 634 635 nsndto = nsndto + 1 635 isendto(nsndto) = jn636 isendto(nsndto) = jn 636 637 END IF 637 END IF638 638 END DO 639 nfsloop = 1 640 nfeloop = nlci 641 DO jn = 2,jpni-1 642 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 643 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 644 nfsloop = nldi 645 ENDIF 646 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 647 nfeloop = nlei 648 ENDIF 649 ENDIF 650 END DO 651 639 652 ENDIF 640 653 l_north_nogather = .TRUE. 641 642 654 END SUBROUTINE nemo_northcomms 643 655 #else -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r4758 r5213 125 125 IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo 126 126 IF(lwp) THEN 127 WRITE(numout,*) ' Tidal c pt name - Phase speed (deg/hr)'127 WRITE(numout,*) ' Tidal components: ' 128 128 DO itide = 1, nb_harmo 129 WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide, omega_tide(itide)129 WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide 130 130 END DO 131 131 ENDIF -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
r4990 r5213 3 3 !! *** MODULE dyndmp *** 4 4 !! Ocean dynamics: internal restoring trend on momentum (U and V current) 5 !! This should only be used for C1D case in current form 5 6 !!====================================================================== 6 7 !! History : 3.5 ! 2013-08 (D. Calvert) Original code 8 !! 3.6 ! 2014-08 (T. Graham) Modified to use netcdf file of 9 !! restoration coefficients supplied to tradmp 7 10 !!---------------------------------------------------------------------- 8 11 … … 25 28 USE wrk_nemo ! Memory allocation 26 29 USE timing ! Timing 30 USE iom ! I/O manager 27 31 28 32 IMPLICIT NONE … … 73 77 NAMELIST/namc1d_dyndmp/ ln_dyndmp 74 78 INTEGER :: ios 79 INTEGER :: imask 75 80 !!---------------------------------------------------------------------- 76 81 … … 91 96 WRITE(numout,*) ' add a damping term or not ln_dyndmp = ', ln_dyndmp 92 97 WRITE(numout,*) ' Namelist namtra_dmp : Set damping parameters' 93 WRITE(numout,*) ' horizontal damping option nn_hdmp = ', nn_hdmp 94 WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp, '(non-C1D zoom: forced to 0)' 95 WRITE(numout,*) ' surface time scale (days) rn_surf = ', rn_surf 96 WRITE(numout,*) ' bottom time scale (days) rn_bot = ', rn_bot 97 WRITE(numout,*) ' depth of transition (meters) rn_dep = ', rn_dep 98 WRITE(numout,*) ' create a damping.coeff file nn_file = ', nn_file 98 WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp 99 WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp 100 WRITE(numout,*) ' Damping file name cn_resto = ', cn_resto 99 101 WRITE(numout,*) 100 102 ENDIF … … 104 106 IF( dyn_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dyn_dmp_init: unable to allocate arrays' ) 105 107 ! 106 #if ! defined key_c1d107 SELECT CASE ( nn_hdmp ) !== control print of horizontal option ==!108 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' momentum damping in the Med & Red seas only'109 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' momentum damping poleward of', nn_hdmp, ' degrees'110 CASE DEFAULT111 WRITE(ctmp1,*) ' bad flag value for nn_hdmp = ', nn_hdmp112 CALL ctl_stop(ctmp1)113 END SELECT114 !115 #endif116 108 SELECT CASE ( nn_zdmp ) !== control print of vertical option ==! 117 109 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' momentum damping throughout the water column' … … 130 122 utrdmp(:,:,:) = 0._wp ! internal damping trends 131 123 vtrdmp(:,:,:) = 0._wp 132 ! !== Damping coefficients calculation: ==! 133 ! !== use tradmp.F90 subroutines dtacof, dtacof_zoom and cofdis ==! 134 ! !!! NOTE: these need to be altered for use in this module if 135 ! !!! they are to be used outside the C1D context 136 ! !!! (use of U,V grid variables) 137 IF( lzoom .AND. .NOT. lk_c1d ) THEN ; CALL dtacof_zoom( resto_uv ) 138 ELSE ; CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'DYN', resto_uv ) 139 ENDIF 140 ! 124 ! 125 !Read in mask from file 126 CALL iom_open ( cn_resto, imask) 127 CALL iom_get ( imask, jpdom_autoglo, 'resto', resto) 128 CALL iom_close( imask ) 141 129 ENDIF 142 130 ! -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r4990 r5213 82 82 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 83 83 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 84 85 CALL iom_put( 'cellthc', fse3t(:,:,:) )86 84 87 85 zarea_ssh(:,:) = area(:,:) * sshn(:,:) -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4990 r5213 142 142 ENDIF 143 143 144 IF( lk_vvl ) THEN 145 z3d(:,:,:) = tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) 146 CALL iom_put( "toce" , z3d ) ! heat content 144 IF( .NOT.lk_vvl ) THEN 145 CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 146 CALL iom_put( "e3u" , fse3u_n(:,:,:) ) 147 CALL iom_put( "e3v" , fse3v_n(:,:,:) ) 148 CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 149 ENDIF 150 151 CALL iom_put( "toce", tsn(:,:,:,jp_tem) ) ! 3D temperature 152 CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature 153 IF ( iom_use("sbt") ) THEN 147 154 DO jj = 1, jpj 148 155 DO ji = 1, jpi 149 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * fse3t_n(ji,jj,mikt(ji,jj)) 150 END DO 151 END DO 152 CALL iom_put( "sst" , z2d(:,:) ) ! sea surface heat content 156 z2d(ji,jj) = tsn(ji,jj,MAX(mbathy(ji,jj),1),jp_tem) 157 END DO 158 END DO 159 CALL iom_put( "sbt", z2d ) ! bottom temperature 160 ENDIF 161 162 CALL iom_put( "soce", tsn(:,:,:,jp_sal) ) ! 3D salinity 163 CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity 164 IF ( iom_use("sbs") ) THEN 153 165 DO jj = 1, jpj 154 166 DO ji = 1, jpi 155 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)**2 * fse3t_n(ji,jj,mikt(ji,jj)) 156 END DO 157 END DO 158 CALL iom_put( "sst2" , z2d(:,:) ) ! sea surface content of squared temperature 159 z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) 160 CALL iom_put( "soce" , z3d ) ! salinity content 167 z2d(ji,jj) = tsn(ji,jj,MAX(mbathy(ji,jj),1),jp_sal) 168 END DO 169 END DO 170 CALL iom_put( "sbs", z2d ) ! bottom salinity 171 ENDIF 172 173 CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current 174 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 175 IF ( iom_use("sbu") ) THEN 161 176 DO jj = 1, jpj 162 177 DO ji = 1, jpi 163 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * fse3t_n(ji,jj,mikt(ji,jj)) 164 END DO 165 END DO 166 CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity content 178 z2d(ji,jj) = un(ji,jj,MAX(mbathy(ji,jj),1)) 179 END DO 180 END DO 181 CALL iom_put( "sbu", z2d ) ! bottom i-current 182 ENDIF 183 184 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current 185 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 186 IF ( iom_use("sbv") ) THEN 167 187 DO jj = 1, jpj 168 188 DO ji = 1, jpi 169 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)**2 * fse3t_n(ji,jj,mikt(ji,jj)) 170 END DO 171 END DO 172 CALL iom_put( "sss2" , z2d(:,:) ) ! sea surface content of squared salinity 173 ELSE 174 CALL iom_put( "toce" , tsn(:,:,:,jp_tem) ) ! temperature 175 IF ( iom_use("sst") ) THEN 176 DO jj = 1, jpj 177 DO ji = 1, jpi 178 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) 179 END DO 180 END DO 181 CALL iom_put( "sst" , z2d(:,:) ) ! sea surface temperature 182 ENDIF 183 IF ( iom_use("sst2") ) CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature 184 CALL iom_put( "soce" , tsn(:,:,:,jp_sal) ) ! salinity 185 IF ( iom_use("sss") ) THEN 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) 189 END DO 190 END DO 191 CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity 192 ENDIF 193 CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity 194 END IF 195 IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 196 CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) * fse3u_n(:,:,:) ) ! i-transport 197 CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) * fse3v_n(:,:,:) ) ! j-transport 198 ELSE 199 CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) ) ! i-current 200 CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) ) ! j-current 201 IF ( iom_use("ssu") ) THEN 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 z2d(ji,jj) = un(ji,jj,miku(ji,jj)) 205 END DO 206 END DO 207 CALL iom_put( "ssu" , z2d ) ! i-current 208 ENDIF 209 IF ( iom_use("ssv") ) THEN 210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 z2d(ji,jj) = vn(ji,jj,mikv(ji,jj)) 213 END DO 214 END DO 215 CALL iom_put( "ssv" , z2d ) ! j-current 216 ENDIF 217 ENDIF 218 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 219 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 220 IF( lk_zdfddm ) THEN 221 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. 222 ENDIF 223 224 IF ( iom_use("sstgrad2") .OR. iom_use("sstgrad2") ) THEN 189 z2d(ji,jj) = vn(ji,jj,MAX(mbathy(ji,jj),1)) 190 END DO 191 END DO 192 CALL iom_put( "sbv", z2d ) ! bottom j-current 193 ENDIF 194 195 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 196 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 197 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm) 198 199 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 225 200 DO jj = 2, jpjm1 ! sst gradient 226 201 DO ji = fs_2, fs_jpim1 ! vector opt. … … 234 209 CALL lbc_lnk( z2d, 'T', 1. ) 235 210 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 236 !CDIR NOVERRCHK<237 211 z2d(:,:) = SQRT( z2d(:,:) ) 238 212 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient … … 243 217 z2d(:,:) = 0._wp 244 218 DO jk = 1, jpkm1 245 DO jj = 2, jpjm1246 DO ji = fs_2, fs_jpim1 ! vector opt.219 DO jj = 1, jpj 220 DO ji = 1, jpi 247 221 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 248 222 END DO 249 223 END DO 250 224 END DO 251 CALL lbc_lnk( z2d, 'T', 1. )252 225 CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2) 253 226 ENDIF … … 256 229 z2d(:,:) = 0._wp 257 230 DO jk = 1, jpkm1 258 DO jj = 2, jpjm1259 DO ji = fs_2, fs_jpim1 ! vector opt.231 DO jj = 1, jpj 232 DO ji = 1, jpi 260 233 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 261 234 END DO 262 235 END DO 263 236 END DO 264 CALL lbc_lnk( z2d, 'T', 1. )265 237 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 266 238 ENDIF -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r4998 r5213 588 588 INTEGER, INTENT( in ) :: kt ! time step 589 589 !! * Local declarations 590 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_e3t_def591 590 INTEGER :: ji,jj,jk ! dummy loop indices 592 591 !!---------------------------------------------------------------------- 593 592 594 593 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_swp') 595 !596 CALL wrk_alloc( jpi, jpj, jpk, z_e3t_def )597 594 ! 598 595 IF( kt == nit000 ) THEN … … 679 676 ! Write outputs 680 677 ! ============= 681 z_e3t_def(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 682 CALL iom_put( "cellthc" , fse3t_n (:,:,:) ) 678 CALL iom_put( "e3t" , fse3t_n (:,:,:) ) 679 CALL iom_put( "e3u" , fse3u_n (:,:,:) ) 680 CALL iom_put( "e3v" , fse3v_n (:,:,:) ) 681 CALL iom_put( "e3w" , fse3w_n (:,:,:) ) 683 682 CALL iom_put( "tpt_dep" , fsde3w_n (:,:,:) ) 684 CALL iom_put( "e3tdef" , z_e3t_def(:,:,:) ) 683 IF( iom_use("e3tdef") ) & 684 CALL iom_put( "e3tdef" , ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 685 685 686 686 ! write restart file 687 687 ! ================== 688 688 IF( lrst_oce ) CALL dom_vvl_rst( kt, 'WRITE' ) 689 !690 CALL wrk_dealloc( jpi, jpj, jpk, z_e3t_def )691 689 ! 692 690 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_sf_swp') -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5015 r5213 365 365 INTEGER :: ji, jj, jl, jk ! dummy loop indices 366 366 INTEGER :: inum ! temporary logical unit 367 INTEGER :: ierror ! error flag 367 368 INTEGER :: ii_bump, ij_bump, ih ! bump center position 368 369 INTEGER :: ii0, ii1, ij0, ij1, ik ! local indices 369 370 REAL(wp) :: r_bump , h_bump , h_oce ! bump characteristics 370 371 REAL(wp) :: zi, zj, zh, zhmin ! local scalars 371 INTEGER , POINTER, DIMENSION(:,:) :: idta ! global domain integer data372 REAL(wp), POINTER, DIMENSION(:,:) :: zdta ! global domain scalar data372 INTEGER , ALLOCATABLE, DIMENSION(:,:) :: idta ! global domain integer data 373 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta ! global domain scalar data 373 374 !!---------------------------------------------------------------------- 374 375 ! 375 376 IF( nn_timing == 1 ) CALL timing_start('zgr_bat') 376 !377 CALL wrk_alloc( jpidta, jpjdta, idta )378 CALL wrk_alloc( jpidta, jpjdta, zdta )379 377 ! 380 378 IF(lwp) WRITE(numout,*) … … 385 383 ! ! ================== ! 386 384 ! ! global domain level and meter bathymetry (idta,zdta) 385 ! 386 ALLOCATE( idta(jpidta,jpjdta), STAT=ierror ) 387 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' ) 388 ALLOCATE( zdta(jpidta,jpjdta), STAT=ierror ) 389 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' ) 387 390 ! 388 391 IF( ntopo == 0 ) THEN ! flat basin … … 489 492 WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp 490 493 END IF 494 ! 495 DEALLOCATE( idta, zdta ) 491 496 ! 492 497 ! ! ================ ! … … 593 598 ENDIF 594 599 ! 595 CALL wrk_dealloc( jpidta, jpjdta, idta )596 CALL wrk_dealloc( jpidta, jpjdta, zdta )597 !598 600 IF( nn_timing == 1 ) CALL timing_stop('zgr_bat') 599 601 ! -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r5026 r5213 89 89 !!---------------------------------------------------------------------- 90 90 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 91 !! $Id$92 91 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 93 92 !!---------------------------------------------------------------------- -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r4990 r5213 116 116 DO jj = 2, jpjm1 ! laplacian 117 117 DO ji = fs_2, fs_jpim1 ! vector opt. 118 zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj,jk)-2.*ub (ji,jj,jk)+ub (ji-1,jj,jk) ) * umask(ji,jj,jk) 119 zlv_vv(ji,jj,jk,1) = ( vb (ji,jj+1,jk)-2.*vb (ji,jj,jk)+vb (ji,jj-1,jk) ) * vmask(ji,jj,jk) 120 zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk) 121 zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk) 122 ! 123 zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk) 124 zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk) 125 zlu_uv(ji,jj,jk,2) = ( zfu(ji,jj+1,jk)-2.*zfu(ji,jj,jk)+zfu(ji,jj-1,jk) ) * umask(ji,jj,jk) 126 zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj,jk)-2.*zfv(ji,jj,jk)+zfv(ji-1,jj,jk) ) * vmask(ji,jj,jk) 127 END DO 128 END DO 129 END DO 130 !!gm BUG !!! just below this should be +1 in all the communications 131 ! CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.) 132 ! CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.) ; CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.) 133 ! CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.) 134 ! CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.) ; CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.) 135 ! 136 !!gm corrected: 118 ! 119 zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj ,jk) ) * umask(ji,jj,jk) 120 zlv_vv(ji,jj,jk,1) = ( vb (ji ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji ,jj-1,jk) ) * vmask(ji,jj,jk) 121 zlu_uv(ji,jj,jk,1) = ( ub (ji ,jj+1,jk) - ub (ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 122 & - ( ub (ji ,jj ,jk) - ub (ji ,jj-1,jk) ) * fmask(ji ,jj-1,jk) 123 zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj ,jk) - vb (ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 124 & - ( vb (ji ,jj ,jk) - vb (ji-1,jj ,jk) ) * fmask(ji-1,jj ,jk) 125 ! 126 zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj ,jk) ) * umask(ji,jj,jk) 127 zlv_vv(ji,jj,jk,2) = ( zfv(ji ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji ,jj-1,jk) ) * vmask(ji,jj,jk) 128 zlu_uv(ji,jj,jk,2) = ( zfu(ji ,jj+1,jk) - zfu(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 129 & - ( zfu(ji ,jj ,jk) - zfu(ji ,jj-1,jk) ) * fmask(ji ,jj-1,jk) 130 zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj ,jk) - zfv(ji ,jj ,jk) ) * fmask(ji ,jj ,jk) & 131 & - ( zfv(ji ,jj ,jk) - zfv(ji-1,jj ,jk) ) * fmask(ji-1,jj ,jk) 132 END DO 133 END DO 134 END DO 137 135 CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. ) ; CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. ) 138 136 CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', 1. ) ; CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', 1. ) 139 137 CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', 1. ) ; CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', 1. ) 140 138 CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', 1. ) ; CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', 1. ) 141 !!gm end142 139 143 140 ! ! ====================== ! -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4770 r5213 97 97 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 98 98 99 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &100 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )99 IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 100 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 101 101 102 102 dyn_spg_ts_alloc = MAXVAL(ierr(:)) … … 218 218 ! 219 219 IF ( kt == nit000 .OR. lk_vvl ) THEN 220 IF ( ln_dynvor_een ) THEN 220 IF ( ln_dynvor_een_old ) THEN 221 DO jj = 1, jpjm1 222 DO ji = 1, jpim1 223 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 224 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 225 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 226 END DO 227 END DO 228 CALL lbc_lnk( zwz, 'F', 1._wp ) 229 zwz(:,:) = ff(:,:) * zwz(:,:) 230 231 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 232 DO jj = 2, jpj 233 DO ji = fs_2, jpi ! vector opt. 234 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 235 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) 236 ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) 237 ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 238 END DO 239 END DO 240 ELSE IF ( ln_dynvor_een ) THEN 221 241 DO jj = 1, jpjm1 222 242 DO ji = 1, jpim1 … … 339 359 END DO 340 360 ! 341 ELSEIF ( ln_dynvor_een ) THEN! enstrophy and energy conserving scheme361 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN ! enstrophy and energy conserving scheme 342 362 DO jj = 2, jpjm1 343 363 DO ji = fs_2, fs_jpim1 ! vector opt. … … 687 707 END DO 688 708 ! 689 ELSEIF ( ln_dynvor_een ) THEN!== energy and enstrophy conserving scheme ==!709 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN !== energy and enstrophy conserving scheme ==! 690 710 DO jj = 2, jpjm1 691 711 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4990 r5213 51 51 LOGICAL, PUBLIC :: ln_dynvor_mix !: mixed scheme 52 52 LOGICAL, PUBLIC :: ln_dynvor_een !: energy and enstrophy conserving scheme 53 LOGICAL, PUBLIC :: ln_dynvor_een_old !: energy and enstrophy conserving scheme (original formulation) 53 54 54 55 INTEGER :: nvor = 0 ! type of vorticity trend used … … 596 597 597 598 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points) 598 DO jk = 1, jpk 599 DO jj = 1, jpjm1 600 DO ji = 1, jpim1 601 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 602 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 603 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 604 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 605 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 606 END DO 607 END DO 608 END DO 599 600 IF( ln_dynvor_een_old ) THEN ! original formulation 601 DO jk = 1, jpk 602 DO jj = 1, jpjm1 603 DO ji = 1, jpim1 604 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 605 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 606 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = 4.0_wp / ze3 607 END DO 608 END DO 609 END DO 610 ELSE ! new formulation from NEMO 3.6 611 DO jk = 1, jpk 612 DO jj = 1, jpjm1 613 DO ji = 1, jpim1 614 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 615 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 616 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 617 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 618 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 619 END DO 620 END DO 621 END DO 622 ENDIF 623 609 624 CALL lbc_lnk( ze3f, 'F', 1. ) 610 625 ENDIF … … 705 720 INTEGER :: ios ! Local integer output status for namelist read 706 721 !! 707 NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 722 NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, ln_dynvor_een_old 708 723 !!---------------------------------------------------------------------- 709 724 … … 726 741 WRITE(numout,*) ' mixed enstrophy/energy conserving scheme ln_dynvor_mix = ', ln_dynvor_mix 727 742 WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een 743 WRITE(numout,*) ' enstrophy and energy conserving scheme (old) ln_dynvor_een_old= ', ln_dynvor_een_old 728 744 ENDIF 729 745 … … 749 765 IF( ln_dynvor_mix ) ioptio = ioptio + 1 750 766 IF( ln_dynvor_een ) ioptio = ioptio + 1 767 IF( ln_dynvor_een_old ) ioptio = ioptio + 1 751 768 IF( lk_esopa ) ioptio = 1 752 769 … … 757 774 IF( ln_dynvor_ens ) nvor = 1 758 775 IF( ln_dynvor_mix ) nvor = 2 759 IF( ln_dynvor_een ) nvor = 3776 IF( ln_dynvor_een .or. ln_dynvor_een_old ) nvor = 3 760 777 IF( lk_esopa ) nvor = -1 761 778 -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5003 r5213 1202 1202 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1203 1203 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. ) 1204 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jp i,:) ; CALL lbc_lnk( zmask, 'V', 1. )1204 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. ) 1205 1205 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1206 1206 END SELECT -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r4520 r5213 164 164 ENDIF 165 165 166 IF ( clinfo3 == 'tra' ) THEN 167 zvctl1 = t_ctll(jn) 168 zvctl2 = s_ctll(jn) 169 ELSEIF ( clinfo3 == 'dyn' ) THEN 170 zvctl1 = u_ctll(jn) 171 zvctl2 = v_ctll(jn) 166 IF( PRESENT(clinfo3)) THEN 167 IF ( clinfo3 == 'tra' ) THEN 168 zvctl1 = t_ctll(jn) 169 zvctl2 = s_ctll(jn) 170 ELSEIF ( clinfo3 == 'dyn' ) THEN 171 zvctl1 = u_ctll(jn) 172 zvctl2 = v_ctll(jn) 173 ENDIF 172 174 ENDIF 173 175 -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
r4325 r5213 146 146 INTEGER :: inum, iim, ijm ! local integers 147 147 INTEGER :: ifreq, il1, il2, ij, ii 148 INTEGER :: ijpt0,ijpt1 148 INTEGER :: ijpt0,ijpt1, ierror 149 149 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk 150 150 CHARACTER (len=15) :: clexp 151 INTEGER, POINTER, DIMENSION(:,:) :: icof152 INTEGER, POINTER, DIMENSION(:,:) :: idata151 INTEGER, POINTER, DIMENSION(:,:) :: icof 152 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: idata 153 153 !!---------------------------------------------------------------------- 154 154 ! 155 155 CALL wrk_alloc( jpi , jpj , icof ) 156 CALL wrk_alloc( jpidta, jpjdta, idata )157 156 ! 158 157 IF(lwp) WRITE(numout,*) … … 234 233 ! ===================== equatorial strip (20N-20S) defined at t-points 235 234 235 ALLOCATE( idata(jpidta,jpjdta), STAT=ierror ) 236 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca: unable to allocate idata array' ) 237 ! 236 238 CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 237 239 READ(inum,9101) clexp, iim, ijm … … 269 271 9201 FORMAT(3x,13(i3,12x)) 270 272 9202 FORMAT(i3,41i3) 271 273 274 DEALLOCATE(idata) 272 275 273 276 ! Set ahm1 and ahm2 ( T- and F- points) (used for laplacian operator) … … 346 349 ! 347 350 CALL wrk_dealloc( jpi , jpj , icof ) 348 CALL wrk_dealloc( jpidta, jpjdta, idata )349 351 ! 350 352 END SUBROUTINE ldf_dyn_c2d_orca … … 374 376 INTEGER :: iim, ijm 375 377 INTEGER :: ifreq, il1, il2, ij, ii 376 INTEGER :: ijpt0,ijpt1 378 INTEGER :: ijpt0,ijpt1, ierror 377 379 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk, zam20s 378 380 CHARACTER (len=15) :: clexp 379 INTEGER, POINTER, DIMENSION(:,:) :: icof380 INTEGER, POINTER, DIMENSION(:,:) :: idata381 INTEGER, POINTER, DIMENSION(:,:) :: icof 382 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: idata 381 383 !!---------------------------------------------------------------------- 382 384 ! 383 385 CALL wrk_alloc( jpi , jpj , icof ) 384 CALL wrk_alloc( jpidta, jpjdta, idata )385 386 ! 386 387 … … 464 465 ! ===================== equatorial strip (20N-20S) defined at t-points 465 466 467 ALLOCATE( idata(jpidta,jpjdta), STAT=ierror ) 468 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'ldf_dyn_c2d_orca_R1: unable to allocate idata array' ) 469 ! 466 470 CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', & 467 471 & 1, numout, lwp ) … … 501 505 9201 FORMAT(3x,13(i3,12x)) 502 506 9202 FORMAT(i3,41i3) 503 507 508 DEALLOCATE(idata) 504 509 505 510 ! Set ahm1 and ahm2 ( T- and F- points) (used for laplacian operator) … … 583 588 ! 584 589 CALL wrk_dealloc( jpi , jpj , icof ) 585 CALL wrk_dealloc( jpidta, jpjdta, idata )586 590 ! 587 591 END SUBROUTINE ldf_dyn_c2d_orca_R1 -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4990 r5213 90 90 !!---------------------------------------------------------------------- 91 91 !! NEMO/OPA 3.7 , NEMO-consortium (2014) 92 !! $Id$93 92 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 94 93 !!---------------------------------------------------------------------- … … 848 847 rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) ) ! If zw10 < 33. => 0, else => 1 849 848 cd_neutral_10m = 1.e-3 * ( & 850 & ( rgt33 + 1._wp)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33.849 & (1._wp - rgt33)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33. 851 850 & + rgt33 * 2.34 ) ! zw10 >= 33. 852 851 ! -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r4990 r5213 21 21 !! tra_dmp : update the tracer trend with the internal damping 22 22 !! tra_dmp_init : initialization, namlist read, parameters control 23 !! dtacof_zoom : restoring coefficient for zoom domain24 !! dtacof : restoring coefficient for global domain25 !! cofdis : compute the distance to the coastline26 23 !!---------------------------------------------------------------------- 27 24 USE oce ! ocean: variables … … 39 36 USE wrk_nemo ! Memory allocation 40 37 USE timing ! Timing 38 USE iom 41 39 42 40 IMPLICIT NONE … … 45 43 PUBLIC tra_dmp ! routine called by step.F90 46 44 PUBLIC tra_dmp_init ! routine called by opa.F90 47 PUBLIC dtacof ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F9048 PUBLIC dtacof_zoom ! routine called by tradmp.F90, trcdmp.F90 and dyndmp.F9049 50 !!gm why all namelist variable public???? only ln_tradmp should be sufficient51 45 52 46 ! !!* Namelist namtra_dmp : T & S newtonian damping * 47 ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90 53 48 LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag 54 INTEGER , PUBLIC :: nn_hdmp ! = 0/-1/'latitude' for damping over T and S55 49 INTEGER , PUBLIC :: nn_zdmp ! = 0/1/2 flag for damping in the mixed layer 56 REAL(wp), PUBLIC :: rn_surf ! surface time scale for internal damping [days] 57 REAL(wp), PUBLIC :: rn_bot ! bottom time scale for internal damping [days] 58 REAL(wp), PUBLIC :: rn_dep ! depth of transition between rn_surf and rn_bot [meters] 59 INTEGER , PUBLIC :: nn_file ! = 1 create a damping.coeff NetCDF file 50 CHARACTER(LEN=200) , PUBLIC :: cn_resto ! name of netcdf file containing restoration coefficient field 51 ! 52 60 53 61 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: strdmp !: damping salinity trend (psu/s) … … 197 190 !! ** Method : read the namtra_dmp namelist and check the parameters 198 191 !!---------------------------------------------------------------------- 199 INTEGER :: ios ! Local integer output status for namelist read 200 !! 201 NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 202 !!---------------------------------------------------------------------- 203 ! 204 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term 192 NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto 193 INTEGER :: ios ! Local integer for output status of namelist read 194 INTEGER :: imask ! File handle 195 !! 196 !!---------------------------------------------------------------------- 197 ! 198 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation 205 199 READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 206 200 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp ) 207 201 ! 208 REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term202 REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation 209 203 READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 210 204 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 211 205 IF(lwm) WRITE ( numond, namtra_dmp ) 212 213 IF( lzoom .AND. .NOT. lk_c1d ) nn_zdmp = 0 ! restoring to climatology at closed north or south boundaries 214 215 IF(lwp) THEN ! Namelist print 206 207 IF(lwp) THEN !Namelist print 216 208 WRITE(numout,*) 217 WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping'209 WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation' 218 210 WRITE(numout,*) '~~~~~~~' 219 WRITE(numout,*) ' Namelist namtra_dmp : set damping parameter' 220 WRITE(numout,*) ' add a damping term or not ln_tradmp = ', ln_tradmp 221 WRITE(numout,*) ' T and S damping option nn_hdmp = ', nn_hdmp 222 WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp, '(non-C1D zoom: forced to 0)' 223 WRITE(numout,*) ' surface time scale (days) rn_surf = ', rn_surf 224 WRITE(numout,*) ' bottom time scale (days) rn_bot = ', rn_bot 225 WRITE(numout,*) ' depth of transition (meters) rn_dep = ', rn_dep 226 WRITE(numout,*) ' create a damping.coeff file nn_file = ', nn_file 211 WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters' 212 WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp 213 WRITE(numout,*) ' mixed layer damping option nn_zdmp = ', nn_zdmp 214 WRITE(numout,*) ' Damping file name cn_resto = ', cn_resto 227 215 WRITE(numout,*) 228 216 ENDIF 229 217 230 IF( ln_tradmp ) THEN ! initialization for T-S damping 231 ! 218 IF( ln_tradmp) THEN 219 ! 220 !Allocate arrays 232 221 IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 233 ! 234 !!gm I don't understand the specificities of c1d case...... 235 !!gm to be check with the autor of these lines 236 237 #if ! defined key_c1d 238 SELECT CASE ( nn_hdmp ) 239 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only' 240 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp, ' degrees' 241 CASE DEFAULT 242 WRITE(ctmp1,*) ' bad flag value for nn_hdmp = ', nn_hdmp 243 CALL ctl_stop(ctmp1) 222 223 !Check values of nn_zdmp 224 SELECT CASE (nn_zdmp) 225 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask' 226 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline' 227 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 244 228 END SELECT 245 ! 246 #endif 247 SELECT CASE ( nn_zdmp ) 248 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping throughout the water column' 249 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline (avt > 5 cm2/s)' 250 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 251 CASE DEFAULT 252 WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 253 CALL ctl_stop(ctmp1) 254 END SELECT 255 ! 229 230 !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine 231 !so can damp to something other than intitial conditions files? 256 232 IF( .NOT.ln_tsd_tradmp ) THEN 257 233 CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 258 234 CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data 259 235 ENDIF 260 ! 261 strdmp(:,:,:) = 0._wp ! internal damping salinity trend (used in asmtrj) 236 237 !initialise arrays - Are these actually used anywhere else? 238 strdmp(:,:,:) = 0._wp 262 239 ttrdmp(:,:,:) = 0._wp 263 ! ! Damping coefficients initialization 264 IF( lzoom .AND. .NOT. lk_c1d ) THEN ; CALL dtacof_zoom( resto )265 ELSE ; CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto)266 ENDIF267 !268 ENDIF269 ! 240 241 !Read in mask from file 242 CALL iom_open ( cn_resto, imask) 243 CALL iom_get ( imask, jpdom_autoglo, 'resto', resto) 244 CALL iom_close( imask ) 245 ENDIF 246 270 247 END SUBROUTINE tra_dmp_init 271 248 272 273 SUBROUTINE dtacof_zoom( presto )274 !!----------------------------------------------------------------------275 !! *** ROUTINE dtacof_zoom ***276 !!277 !! ** Purpose : Compute the damping coefficient for zoom domain278 !!279 !! ** Method : - set along closed boundary due to zoom a damping over280 !! 6 points with a max time scale of 5 days.281 !! - ORCA arctic/antarctic zoom: set the damping along282 !! south/north boundary over a latitude strip.283 !!284 !! ** Action : - resto, the damping coeff. for T and S285 !!----------------------------------------------------------------------286 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1)287 !288 INTEGER :: ji, jj, jk, jn ! dummy loop indices289 REAL(wp) :: zlat, zlat0, zlat1, zlat2, z1_5d ! local scalar290 REAL(wp), DIMENSION(6) :: zfact ! 1Dworkspace291 !!----------------------------------------------------------------------292 !293 IF( nn_timing == 1 ) CALL timing_start( 'dtacof_zoom')294 !295 296 zfact(1) = 1._wp297 zfact(2) = 1._wp298 zfact(3) = 11._wp / 12._wp299 zfact(4) = 8._wp / 12._wp300 zfact(5) = 4._wp / 12._wp301 zfact(6) = 1._wp / 12._wp302 zfact(:) = zfact(:) / ( 5._wp * rday ) ! 5 days max restoring time scale303 304 presto(:,:,:) = 0._wp305 306 ! damping along the forced closed boundary over 6 grid-points307 DO jn = 1, 6308 IF( lzoom_w ) presto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : ) = zfact(jn) ! west closed309 IF( lzoom_s ) presto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : ) = zfact(jn) ! south closed310 IF( lzoom_e ) presto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn) ! east closed311 IF( lzoom_n ) presto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn) ! north closed312 END DO313 314 ! ! ====================================================315 IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN ! ORCA configuration : arctic or antarctic zoom316 ! ! ====================================================317 IF(lwp) WRITE(numout,*)318 IF(lwp .AND. cp_cfz == "arctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Arctic zoom'319 IF(lwp .AND. cp_cfz == "antarctic" ) WRITE(numout,*) ' dtacof_zoom : ORCA Antarctic zoom'320 IF(lwp) WRITE(numout,*)321 !322 ! ! Initialization :323 presto(:,:,:) = 0._wp324 zlat0 = 10._wp ! zlat0 : latitude strip where resto decreases325 zlat1 = 30._wp ! zlat1 : resto = 1 before zlat1326 zlat2 = zlat1 + zlat0 ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2327 z1_5d = 1._wp / ( 5._wp * rday ) ! z1_5d : 1 / 5days328 329 DO jk = 2, jpkm1 ! Compute arrays resto ; value for internal damping : 5 days330 DO jj = 1, jpj331 DO ji = 1, jpi332 zlat = ABS( gphit(ji,jj) )333 IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN334 presto(ji,jj,jk) = 0.5_wp * z1_5d * ( 1._wp - COS( rpi*(zlat2-zlat)/zlat0 ) )335 ELSEIF( zlat < zlat1 ) THEN336 presto(ji,jj,jk) = z1_5d337 ENDIF338 END DO339 END DO340 END DO341 !342 ENDIF343 ! ! Mask resto array344 presto(:,:,:) = presto(:,:,:) * tmask(:,:,:)345 !346 IF( nn_timing == 1 ) CALL timing_stop( 'dtacof_zoom')347 !348 END SUBROUTINE dtacof_zoom349 350 351 SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep, &352 & kn_file, cdtype , presto )353 !!----------------------------------------------------------------------354 !! *** ROUTINE dtacof ***355 !!356 !! ** Purpose : Compute the damping coefficient357 !!358 !! ** Method : Arrays defining the damping are computed for each grid359 !! point for temperature and salinity (resto)360 !! Damping depends on distance to coast, depth and latitude361 !!362 !! ** Action : - resto, the damping coeff. for T and S363 !!----------------------------------------------------------------------364 USE iom365 USE ioipsl366 !!367 INTEGER , INTENT(in ) :: kn_hdmp ! damping option368 REAL(wp) , INTENT(in ) :: pn_surf ! surface time scale (days)369 REAL(wp) , INTENT(in ) :: pn_bot ! bottom time scale (days)370 REAL(wp) , INTENT(in ) :: pn_dep ! depth of transition (meters)371 INTEGER , INTENT(in ) :: kn_file ! save the damping coef on a file or not372 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA, TRC or DYN (tracer/dynamics indicator)373 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: presto ! restoring coeff. (s-1)374 !375 INTEGER :: ji, jj, jk ! dummy loop indices376 INTEGER :: ii0, ii1, ij0, ij1 ! local integers377 INTEGER :: inum0, icot ! - -378 REAL(wp) :: zinfl, zlon ! local scalars379 REAL(wp) :: zlat, zlat0, zlat1, zlat2 ! - -380 REAL(wp) :: zsdmp, zbdmp ! - -381 CHARACTER(len=20) :: cfile382 REAL(wp), POINTER, DIMENSION(: ) :: zhfac383 REAL(wp), POINTER, DIMENSION(:,: ) :: zmrs384 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdct385 !!----------------------------------------------------------------------386 !387 IF( nn_timing == 1 ) CALL timing_start('dtacof')388 !389 CALL wrk_alloc( jpk, zhfac )390 CALL wrk_alloc( jpi, jpj, zmrs )391 CALL wrk_alloc( jpi, jpj, jpk, zdct )392 #if defined key_c1d393 ! ! ====================394 ! ! C1D configuration : local domain395 ! ! ====================396 !397 IF(lwp) WRITE(numout,*)398 IF(lwp) WRITE(numout,*) ' dtacof : C1D 3x3 local domain'399 IF(lwp) WRITE(numout,*) ' -----------------------------'400 !401 presto(:,:,:) = 0._wp402 !403 zsdmp = 1._wp / ( pn_surf * rday )404 zbdmp = 1._wp / ( pn_bot * rday )405 DO jk = 2, jpkm1406 DO jj = 1, jpj407 DO ji = 1, jpi408 ! ONLY vertical variation from zsdmp (sea surface) to zbdmp (bottom)409 presto(ji,jj,jk) = zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep)410 END DO411 END DO412 END DO413 !414 presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)415 #else416 ! ! ====================417 ! ! ORCA configuration : global domain418 ! ! ====================419 !420 IF(lwp) WRITE(numout,*)421 IF(lwp) WRITE(numout,*) ' dtacof : Global domain of ORCA'422 IF(lwp) WRITE(numout,*) ' ------------------------------'423 !424 presto(:,:,:) = 0._wp425 !426 IF( kn_hdmp > 0 ) THEN ! Damping poleward of 'nn_hdmp' degrees !427 ! !-----------------------------------------!428 IF(lwp) WRITE(numout,*)429 IF(lwp) WRITE(numout,*) ' Damping poleward of ', kn_hdmp, ' deg.'430 !431 CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. )432 !433 IF( icot > 0 ) THEN ! distance-to-coast read in file434 CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct )435 CALL iom_close( icot )436 ELSE ! distance-to-coast computed and saved in file (output in zdct)437 CALL cofdis( zdct )438 ENDIF439 440 ! ! Compute arrays resto441 zinfl = 1000.e3_wp ! distance of influence for damping term442 zlat0 = 10._wp ! latitude strip where resto decreases443 zlat1 = REAL( kn_hdmp ) ! resto = 0 between -zlat1 and zlat1444 zlat2 = zlat1 + zlat0 ! resto increases from 0 to 1 between |zlat1| and |zlat2|445 446 DO jj = 1, jpj447 DO ji = 1, jpi448 zlat = ABS( gphit(ji,jj) )449 IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN450 presto(ji,jj,1) = 0.5_wp * ( 1._wp - COS( rpi*(zlat-zlat1)/zlat0 ) )451 ELSEIF ( zlat > zlat2 ) THEN452 presto(ji,jj,1) = 1._wp453 ENDIF454 END DO455 END DO456 457 IF ( kn_hdmp == 20 ) THEN ! North Indian ocean (20N/30N x 45E/100E) : resto=0458 DO jj = 1, jpj459 DO ji = 1, jpi460 zlat = gphit(ji,jj)461 zlon = MOD( glamt(ji,jj), 360._wp )462 IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45._wp < zlon .AND. zlon < 100._wp ) THEN463 presto(ji,jj,1) = 0._wp464 ENDIF465 END DO466 END DO467 ENDIF468 469 zsdmp = 1._wp / ( pn_surf * rday )470 zbdmp = 1._wp / ( pn_bot * rday )471 DO jk = 2, jpkm1472 DO jj = 1, jpj473 DO ji = 1, jpi474 zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )475 ! ... Decrease the value in the vicinity of the coast476 presto(ji,jj,jk) = presto(ji,jj,1 ) * 0.5_wp * ( 1._wp - COS( rpi*zdct(ji,jj,jk)/zinfl) )477 ! ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)478 presto(ji,jj,jk) = presto(ji,jj,jk) * ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep) )479 END DO480 END DO481 END DO482 !483 ENDIF484 485 ! ! =========================486 ! ! Med and Red Sea damping (ORCA configuration only)487 ! ! =========================488 IF( cp_cfg == "orca" .AND. ( kn_hdmp > 0 .OR. kn_hdmp == -1 ) ) THEN489 IF(lwp)WRITE(numout,*)490 IF(lwp)WRITE(numout,*) ' ORCA configuration: Damping in Med and Red Seas'491 !492 zmrs(:,:) = 0._wp493 !494 SELECT CASE ( jp_cfg )495 ! ! =======================496 CASE ( 4 ) ! ORCA_R4 configuration497 ! ! =======================498 ij0 = 50 ; ij1 = 56 ! Mediterranean Sea499 500 ii0 = 81 ; ii1 = 91 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp501 ij0 = 50 ; ij1 = 55502 ii0 = 75 ; ii1 = 80 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp503 ij0 = 52 ; ij1 = 53504 ii0 = 70 ; ii1 = 74 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp505 ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea506 DO jk = 1, 17507 zhfac (jk) = 0.5_wp * ( 1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday508 END DO509 DO jk = 18, jpkm1510 zhfac (jk) = 1._wp / rday511 END DO512 ! ! =======================513 CASE ( 2 ) ! ORCA_R2 configuration514 ! ! =======================515 ij0 = 96 ; ij1 = 110 ! Mediterranean Sea516 ii0 = 157 ; ii1 = 181 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp517 ij0 = 100 ; ij1 = 110518 ii0 = 144 ; ii1 = 156 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp519 ij0 = 100 ; ij1 = 103520 ii0 = 139 ; ii1 = 143 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp521 !522 ij0 = 101 ; ij1 = 102 ! Decrease before Gibraltar Strait523 ii0 = 139 ; ii1 = 141 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp524 ii0 = 142 ; ii1 = 142 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp525 ii0 = 143 ; ii1 = 143 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp526 ii0 = 144 ; ii1 = 144 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp527 !528 ij0 = 87 ; ij1 = 96 ! Red Sea529 ii0 = 147 ; ii1 = 163 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp530 !531 ij0 = 91 ; ij1 = 91 ! Decrease before Bab el Mandeb Strait532 ii0 = 153 ; ii1 = 160 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80_wp533 ij0 = 90 ; ij1 = 90534 ii0 = 153 ; ii1 = 160 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp535 ij0 = 89 ; ij1 = 89536 ii0 = 158 ; ii1 = 160 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp537 ij0 = 88 ; ij1 = 88538 ii0 = 160 ; ii1 = 163 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp539 ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea540 DO jk = 1, 17541 zhfac (jk) = 0.5_wp * ( 1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp ) ) / rday542 END DO543 DO jk = 18, jpkm1544 zhfac (jk) = 1._wp / rday545 END DO546 ! ! =======================547 CASE ( 05 ) ! ORCA_R05 configuration548 ! ! =======================549 ii0 = 568 ; ii1 = 574 ! Mediterranean Sea550 ij0 = 324 ; ij1 = 333 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp551 ii0 = 575 ; ii1 = 658552 ij0 = 314 ; ij1 = 366 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp553 !554 ii0 = 641 ; ii1 = 651 ! Black Sea (remaining part555 ij0 = 367 ; ij1 = 372 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp556 !557 ij0 = 324 ; ij1 = 333 ! Decrease before Gibraltar Strait558 ii0 = 565 ; ii1 = 565 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp559 ii0 = 566 ; ii1 = 566 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp560 ii0 = 567 ; ii1 = 567 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp561 !562 ii0 = 641 ; ii1 = 665 ! Red Sea563 ij0 = 270 ; ij1 = 310 ; zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp564 !565 ii0 = 666 ; ii1 = 675 ! Decrease before Bab el Mandeb Strait566 ij0 = 270 ; ij1 = 290567 DO ji = mi0(ii0), mi1(ii1)568 zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1_wp * ABS( FLOAT(ji - mi1(ii1)) )569 END DO570 zsdmp = 1._wp / ( pn_surf * rday )571 zbdmp = 1._wp / ( pn_bot * rday )572 DO jk = 1, jpk573 zhfac(jk) = ( zbdmp + (zsdmp-zbdmp) * EXP( -fsdept(1,1,jk)/pn_dep ) )574 END DO575 ! ! ========================576 CASE ( 025 ) ! ORCA_R025 configuration577 ! ! ========================578 CALL ctl_stop( ' Not yet implemented in ORCA_R025' )579 !580 END SELECT581 582 DO jk = 1, jpkm1583 presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk)584 END DO585 586 ! Mask resto array and set to 0 first and last levels587 presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)588 presto(:,:, 1 ) = 0._wp589 presto(:,:,jpk) = 0._wp590 ! !--------------------!591 ELSE ! No damping !592 ! !--------------------!593 CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' )594 ENDIF595 #endif596 597 ! !--------------------------------!598 IF( kn_file == 1 ) THEN ! save damping coef. in a file !599 ! !--------------------------------!600 IF(lwp) WRITE(numout,*) ' create damping.coeff.nc file'601 IF( cdtype == 'TRA' ) cfile = 'damping.coeff'602 IF( cdtype == 'TRC' ) cfile = 'damping.coeff.trc'603 IF( cdtype == 'DYN' ) cfile = 'damping.coeff.dyn'604 cfile = TRIM( cfile )605 CALL iom_open ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )606 CALL iom_rstput( 0, 0, inum0, 'Resto', presto )607 CALL iom_close ( inum0 )608 ENDIF609 !610 CALL wrk_dealloc( jpk, zhfac)611 CALL wrk_dealloc( jpi, jpj, zmrs )612 CALL wrk_dealloc( jpi, jpj, jpk, zdct )613 !614 IF( nn_timing == 1 ) CALL timing_stop('dtacof')615 !616 END SUBROUTINE dtacof617 618 619 SUBROUTINE cofdis( pdct )620 !!----------------------------------------------------------------------621 !! *** ROUTINE cofdis ***622 !!623 !! ** Purpose : Compute the distance between ocean T-points and the624 !! ocean model coastlines. Save the distance in a NetCDF file.625 !!626 !! ** Method : For each model level, the distance-to-coast is627 !! computed as follows :628 !! - The coastline is defined as the serie of U-,V-,F-points629 !! that are at the ocean-land bound.630 !! - For each ocean T-point, the distance-to-coast is then631 !! computed as the smallest distance (on the sphere) between the632 !! T-point and all the coastline points.633 !! - For land T-points, the distance-to-coast is set to zero.634 !! C A U T I O N : Computation not yet implemented in mpp case.635 !!636 !! ** Action : - pdct, distance to the coastline (argument)637 !! - NetCDF file 'dist.coast.nc'638 !!----------------------------------------------------------------------639 USE ioipsl ! IOipsl librairy640 !!641 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: pdct ! distance to the coastline642 !!643 INTEGER :: ji, jj, jk, jl ! dummy loop indices644 INTEGER :: iju, ijt, icoast, itime, ierr, icot ! local integers645 CHARACTER (len=32) :: clname ! local name646 REAL(wp) :: zdate0 ! local scalar647 REAL(wp), POINTER, DIMENSION(:,:) :: zxt, zyt, zzt, zmask648 REAL(wp), POINTER, DIMENSION(: ) :: zxc, zyc, zzc, zdis ! temporary workspace649 LOGICAL , ALLOCATABLE, DIMENSION(:,:) :: llcotu, llcotv, llcotf ! 2D logical workspace650 !!----------------------------------------------------------------------651 !652 IF( nn_timing == 1 ) CALL timing_start('cofdis')653 !654 CALL wrk_alloc( jpi, jpj , zxt, zyt, zzt, zmask )655 CALL wrk_alloc( 3*jpi*jpj, zxc, zyc, zzc, zdis )656 ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj) )657 !658 IF( lk_mpp ) CALL mpp_sum( ierr )659 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'cofdis: requested local arrays unavailable')660 661 ! 0. Initialization662 ! -----------------663 IF(lwp) WRITE(numout,*)664 IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline'665 IF(lwp) WRITE(numout,*) '~~~~~~'666 IF(lwp) WRITE(numout,*)667 IF( lk_mpp ) &668 & CALL ctl_stop(' Computation not yet implemented with key_mpp_...', &669 & ' Rerun the code on another computer or ', &670 & ' create the "dist.coast.nc" file using IDL' )671 672 pdct(:,:,:) = 0._wp673 zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )674 zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )675 zzt(:,:) = SIN( rad * gphit(:,:) )676 677 678 ! 1. Loop on vertical levels679 ! --------------------------680 ! ! ===============681 DO jk = 1, jpkm1 ! Horizontal slab682 ! ! ===============683 ! Define the coastline points (U, V and F)684 DO jj = 2, jpjm1685 DO ji = 2, jpim1686 zmask(ji,jj) = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &687 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) )688 llcotu(ji,jj) = ( tmask(ji,jj, jk) + tmask(ji+1,jj ,jk) == 1._wp )689 llcotv(ji,jj) = ( tmask(ji,jj ,jk) + tmask(ji ,jj+1,jk) == 1._wp )690 llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )691 END DO692 END DO693 694 ! Lateral boundaries conditions695 llcotu(:, 1 ) = umask(:, 2 ,jk) == 1696 llcotu(:,jpj) = umask(:,jpjm1,jk) == 1697 llcotv(:, 1 ) = vmask(:, 2 ,jk) == 1698 llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1699 llcotf(:, 1 ) = fmask(:, 2 ,jk) == 1700 llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1701 702 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN703 llcotu( 1 ,:) = llcotu(jpim1,:)704 llcotu(jpi,:) = llcotu( 2 ,:)705 llcotv( 1 ,:) = llcotv(jpim1,:)706 llcotv(jpi,:) = llcotv( 2 ,:)707 llcotf( 1 ,:) = llcotf(jpim1,:)708 llcotf(jpi,:) = llcotf( 2 ,:)709 ELSE710 llcotu( 1 ,:) = umask( 2 ,:,jk) == 1711 llcotu(jpi,:) = umask(jpim1,:,jk) == 1712 llcotv( 1 ,:) = vmask( 2 ,:,jk) == 1713 llcotv(jpi,:) = vmask(jpim1,:,jk) == 1714 llcotf( 1 ,:) = fmask( 2 ,:,jk) == 1715 llcotf(jpi,:) = fmask(jpim1,:,jk) == 1716 ENDIF717 IF( nperio == 3 .OR. nperio == 4 ) THEN718 DO ji = 1, jpim1719 iju = jpi - ji + 1720 llcotu(ji,jpj ) = llcotu(iju,jpj-2)721 llcotf(ji,jpjm1) = llcotf(iju,jpj-2)722 llcotf(ji,jpj ) = llcotf(iju,jpj-3)723 END DO724 DO ji = jpi/2, jpim1725 iju = jpi - ji + 1726 llcotu(ji,jpjm1) = llcotu(iju,jpjm1)727 END DO728 DO ji = 2, jpi729 ijt = jpi - ji + 2730 llcotv(ji,jpjm1) = llcotv(ijt,jpj-2)731 llcotv(ji,jpj ) = llcotv(ijt,jpj-3)732 END DO733 ENDIF734 IF( nperio == 5 .OR. nperio == 6 ) THEN735 DO ji = 1, jpim1736 iju = jpi - ji737 llcotu(ji,jpj ) = llcotu(iju,jpjm1)738 llcotf(ji,jpj ) = llcotf(iju,jpj-2)739 END DO740 DO ji = jpi/2, jpim1741 iju = jpi - ji742 llcotf(ji,jpjm1) = llcotf(iju,jpjm1)743 END DO744 DO ji = 1, jpi745 ijt = jpi - ji + 1746 llcotv(ji,jpj ) = llcotv(ijt,jpjm1)747 END DO748 DO ji = jpi/2+1, jpi749 ijt = jpi - ji + 1750 llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)751 END DO752 ENDIF753 754 ! Compute cartesian coordinates of coastline points755 ! and the number of coastline points756 icoast = 0757 DO jj = 1, jpj758 DO ji = 1, jpi759 IF( llcotf(ji,jj) ) THEN760 icoast = icoast + 1761 zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )762 zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )763 zzc(icoast) = SIN( rad*gphif(ji,jj) )764 ENDIF765 IF( llcotu(ji,jj) ) THEN766 icoast = icoast+1767 zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )768 zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )769 zzc(icoast) = SIN( rad*gphiu(ji,jj) )770 ENDIF771 IF( llcotv(ji,jj) ) THEN772 icoast = icoast+1773 zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )774 zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )775 zzc(icoast) = SIN( rad*gphiv(ji,jj) )776 ENDIF777 END DO778 END DO779 780 ! Distance for the T-points781 DO jj = 1, jpj782 DO ji = 1, jpi783 IF( tmask(ji,jj,jk) == 0._wp ) THEN784 pdct(ji,jj,jk) = 0._wp785 ELSE786 DO jl = 1, icoast787 zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2 &788 & + ( zyt(ji,jj) - zyc(jl) )**2 &789 & + ( zzt(ji,jj) - zzc(jl) )**2790 END DO791 pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) )792 ENDIF793 END DO794 END DO795 ! ! ===============796 END DO ! End of slab797 ! ! ===============798 799 800 ! 2. Create the distance to the coast file in NetCDF format801 ! ----------------------------------------------------------802 clname = 'dist.coast'803 itime = 0804 CALL ymds2ju( 0 , 1 , 1 , 0._wp , zdate0 )805 CALL restini( 'NONE', jpi , jpj , glamt, gphit , &806 & jpk , gdept_1d, clname, itime, zdate0, &807 & rdt , icot )808 CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )809 CALL restclo( icot )810 !811 CALL wrk_dealloc( jpi, jpj , zxt, zyt, zzt, zmask )812 CALL wrk_dealloc( 3*jpi*jpj, zxc, zyc, zzc, zdis )813 DEALLOCATE( llcotu, llcotv, llcotf )814 !815 IF( nn_timing == 1 ) CALL timing_stop('cofdis')816 !817 END SUBROUTINE cofdis818 !!======================================================================819 249 END MODULE tradmp -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r4990 r5213 24 24 USE trdtra 25 25 USE trd_oce 26 USE iom 26 27 27 28 IMPLICIT NONE … … 302 303 !!---------------------------------------------------------------------- 303 304 ! 305 INTEGER :: imask !local file handle 306 304 307 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 305 308 ! 306 SELECT CASE ( nn_hdmp_tr )307 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only'308 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp_tr, ' degrees'309 CASE DEFAULT310 WRITE(ctmp1,*) ' bad flag value for nn_hdmp_tr = ', nn_hdmp_tr311 CALL ctl_stop(ctmp1)312 END SELECT313 309 314 310 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries … … 325 321 & CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 326 322 ! 327 ! ! Damping coefficients initialization328 IF( lzoom ) THEN ; CALL dtacof_zoom( restotr )329 ELSE ; CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr, &330 & nn_file_tr, 'TRC' , restotr)331 ENDIF323 ! ! Read damping coefficients from file 324 !Read in mask from file 325 CALL iom_open ( cn_resto_tr, imask) 326 CALL iom_get ( imask, jpdom_autoglo, 'resto', restotr) 327 CALL iom_close( imask ) 332 328 ! 333 329 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init') -
branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r4624 r5213 51 51 ! !!: ** newtonian damping namelist (nam_trcdmp) ** 52 52 ! !!* Namelist namtrc_dmp : passive tracer newtonian damping * 53 INTEGER , PUBLIC :: nn_hdmp_tr ! = 0/-1/'latitude' for damping over passive tracer54 53 INTEGER , PUBLIC :: nn_zdmp_tr ! = 0/1/2 flag for damping in the mixed layer 55 REAL(wp), PUBLIC :: rn_surf_tr ! surface time scale for internal damping [days] 56 REAL(wp), PUBLIC :: rn_bot_tr ! bottom time scale for internal damping [days] 57 REAL(wp), PUBLIC :: rn_dep_tr ! depth of transition between rn_surf and rn_bot [meters] 58 INTEGER , PUBLIC :: nn_file_tr ! = 1 create a damping.coeff NetCDF file 54 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient 59 55 60 56 !!---------------------------------------------------------------------- … … 82 78 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 83 79 NAMELIST/namtrc_rad/ ln_trcrad 84 NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, & 85 & rn_bot_tr , rn_dep_tr , nn_file_tr 80 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 86 81 !!---------------------------------------------------------------------- 87 82 … … 184 179 WRITE(numout,*) '~~~~~~~' 185 180 WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter' 186 WRITE(numout,*) ' tracer damping option nn_hdmp_tr = ', nn_hdmp_tr187 181 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 188 WRITE(numout,*) ' surface time scale (days) rn_surf_tr = ', rn_surf_tr 189 WRITE(numout,*) ' bottom time scale (days) rn_bot_tr = ', rn_bot_tr 190 WRITE(numout,*) ' depth of transition (meters) rn_dep_tr = ', rn_dep_tr 191 WRITE(numout,*) ' create a damping.coeff file nn_file_tr = ', nn_file_tr 182 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 192 183 ENDIF 193 184 !
Note: See TracChangeset
for help on using the changeset viewer.
