Changeset 3398 for branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM
- Timestamp:
- 2012-05-22T09:37:43+02:00 (12 years ago)
- Location:
- branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/CONFIG/cfg.txt
r3295 r3398 1 GYRE OPA_SRC2 1 GYRE_LOBSTER OPA_SRC TOP_SRC 3 2 ORCA2_LIM3 OPA_SRC LIM_SRC_3 … … 7 6 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 8 7 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 8 GYRE OPA_SRC 9 PELAGOS025 OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 10 GYRE_BFM OPA_SRC TOP_SRC 11 PELAGOS OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90
r2281 r3398 678 678 io_sl(v_d_ul(iv))=it 679 679 ENDIF 680 ENDIF 681 !-------- Initialize to zero variables data 682 ! approximate dimension 683 IF ( it == 1 .AND. l_cgd) THEN 684 ! Enter I*J I*J is larger thant total number of single files 685 if ( ((f_d_l(1)/(d_s_l(1,1)-3)) * (f_d_l(2)/(d_s_l(2,1)-3) )) .gt. d_n_t ) then 686 CALL ZeroFill (f_id_o, f_v_nm(iv), f_d_l, v_d_nb(iv), v_type(iv), v_d_i(1:v_d_nb(iv),iv)) 687 endif 680 688 ENDIF 681 689 ENDIF … … 1621 1629 END SUBROUTINE flrb_rg 1622 1630 !=== 1631 SUBROUTINE ZeroFill(f_id_o,f_v_nm,f_d_l,v_d_nb,v_type,v_d_i) 1632 1633 IMPLICIT NONE 1634 ! Character length 1635 INTEGER,PARAMETER :: chlen=256 1636 1637 INTEGER :: v_d_nb, v_type ! variable # of dims, variable type, var Unlim dimension 1638 INTEGER :: f_id_o ! Output file ID 1639 INTEGER,DIMENSION(:) :: f_d_l, v_d_i ! Global dimensions, variable dimensio ID 1640 CHARACTER(LEN=chlen) :: f_v_nm ! Variable name 1641 INTEGER,DIMENSION(:),ALLOCATABLE :: dims 1642 1643 INTEGER(KIND=i_2) :: i2_0d 1644 INTEGER(KIND=i_2), ALLOCATABLE :: i2_1d(:), i2_2d(:,:), i2_3d(:,:,:), i2_4d(:,:,:,:), i2_5d(:,:,:,:,:) 1645 INTEGER(KIND=i_4) :: i4_0d 1646 INTEGER(KIND=i_4), ALLOCATABLE :: i4_1d(:), i4_2d(:,:), i4_3d(:,:,:), i4_4d(:,:,:,:), i4_5d(:,:,:,:,:) 1647 REAL(KIND=r_4) :: r4_0d 1648 REAL(KIND=r_4), ALLOCATABLE :: r4_1d(:), r4_2d(:,:), r4_3d(:,:,:), r4_4d(:,:,:,:), r4_5d(:,:,:,:,:) 1649 REAL(KIND=r_8) :: r8_0d 1650 REAL(KIND=r_8), ALLOCATABLE :: r8_1d(:), r8_2d(:,:), r8_3d(:,:,:), r8_4d(:,:,:,:), r8_5d(:,:,:,:,:) 1651 1652 ! write(*,*) ' Into my sub... TOM' 1653 ! write(*,*) f_id_o, TRIM(f_v_nm), v_d_nb , v_type 1654 write(*,*) 'Variable: ',TRIM(f_v_nm), ' intiliazed to zero' 1655 write(*,*) 1656 1657 ! define variable dimension 1658 ALLOCATE(dims(v_d_nb)) 1659 dims=f_d_l(v_d_i) 1660 SELECT CASE(v_type) 1661 ! INTEGER 1 and 2 1662 CASE (flio_i1,flio_i2) 1663 SELECT CASE (v_d_nb) 1664 CASE(1) 1665 ALLOCATE(i2_1d(dims(1))) 1666 i2_1d=0 1667 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_1d) 1668 DEALLOCATE(i2_1d) 1669 CASE(2) 1670 ALLOCATE(i2_2d(dims(1),dims(2))) 1671 i2_2d=0 1672 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_2d) 1673 DEALLOCATE(i2_2d) 1674 CASE(3) 1675 ALLOCATE(i2_3d(dims(1),dims(2),dims(3))) 1676 i2_3d=0 1677 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_3d) 1678 DEALLOCATE(i2_3d) 1679 CASE(4) 1680 ALLOCATE(i2_4d(dims(1),dims(2),dims(3),dims(4))) 1681 i2_4d=0 1682 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_4d) 1683 DEALLOCATE(i2_4d) 1684 CASE(5) 1685 ALLOCATE(i2_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1686 i2_5d=0 1687 CALL flioputv (f_id_o,TRIM(f_v_nm),i2_5d) 1688 DEALLOCATE(i2_5d) 1689 END SELECT 1690 ! INTEGER 4 1691 CASE (flio_i4) 1692 SELECT CASE (v_d_nb) 1693 CASE(1) 1694 ALLOCATE(i4_1d(dims(1))) 1695 i4_1d=0 1696 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_1d) 1697 DEALLOCATE(i4_1d) 1698 CASE(2) 1699 ALLOCATE(i4_2d(dims(1),dims(2))) 1700 i4_2d=0 1701 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_2d) 1702 DEALLOCATE(i4_2d) 1703 CASE(3) 1704 ALLOCATE(i4_3d(dims(1),dims(2),dims(3))) 1705 i4_3d=0 1706 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_3d) 1707 DEALLOCATE(i4_3d) 1708 CASE(4) 1709 ALLOCATE(i4_4d(dims(1),dims(2),dims(3),dims(4))) 1710 i4_4d=0 1711 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_4d) 1712 DEALLOCATE(i4_4d) 1713 CASE(5) 1714 ALLOCATE(i4_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1715 i4_5d=0 1716 CALL flioputv (f_id_o,TRIM(f_v_nm),i4_5d) 1717 DEALLOCATE(i4_5d) 1718 END SELECT 1719 ! FLOAT 4 1720 CASE (flio_r4) 1721 SELECT CASE (v_d_nb) 1722 CASE(1) 1723 ALLOCATE(r4_1d(dims(1))) 1724 r4_1d=0 1725 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_1d) 1726 DEALLOCATE(r4_1d) 1727 CASE(2) 1728 ALLOCATE(r4_2d(dims(1),dims(2))) 1729 r4_2d=0 1730 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_2d) 1731 DEALLOCATE(r4_2d) 1732 CASE(3) 1733 ALLOCATE(r4_3d(dims(1),dims(2),dims(3))) 1734 r4_3d=0 1735 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_3d) 1736 DEALLOCATE(r4_3d) 1737 CASE(4) 1738 ALLOCATE(r4_4d(dims(1),dims(2),dims(3),dims(4))) 1739 r4_4d=0 1740 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_4d) 1741 DEALLOCATE(r4_4d) 1742 CASE(5) 1743 ALLOCATE(r4_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1744 r4_5d=0 1745 CALL flioputv (f_id_o,TRIM(f_v_nm),r4_5d) 1746 DEALLOCATE(r4_5d) 1747 END SELECT 1748 ! FLOAT 8 1749 CASE (flio_r8) 1750 SELECT CASE (v_d_nb) 1751 CASE(1) 1752 ALLOCATE(r8_1d(dims(1))) 1753 r8_1d=0 1754 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_1d) 1755 DEALLOCATE(r8_1d) 1756 CASE(2) 1757 ALLOCATE(r8_2d(dims(1),dims(2))) 1758 r8_2d=0 1759 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_2d) 1760 DEALLOCATE(r8_2d) 1761 CASE(3) 1762 ALLOCATE(r8_3d(dims(1),dims(2),dims(3))) 1763 r8_3d=0 1764 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_3d) 1765 DEALLOCATE(r8_3d) 1766 CASE(4) 1767 ALLOCATE(r8_4d(dims(1),dims(2),dims(3),dims(4))) 1768 r8_4d=0 1769 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_4d) 1770 DEALLOCATE(r8_4d) 1771 CASE(5) 1772 ALLOCATE(r8_5d(dims(1),dims(2),dims(3),dims(4),dims(5))) 1773 r8_5d=0 1774 CALL flioputv (f_id_o,TRIM(f_v_nm),r8_5d) 1775 DEALLOCATE(r8_5d) 1776 END SELECT 1777 END SELECT 1778 1779 DEALLOCATE (dims) 1780 1781 END SUBROUTINE 1782 !=== 1623 1783 !-------------------- 1624 1784 END PROGRAM flio_rbld -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r3294 r3398 831 831 IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 ) sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 832 832 sdf(jf)%vcomp = sdf_n(jf)%vcomp 833 sdf(jf)%rotn = .FALSE. 833 834 END DO 834 835 -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3294 r3398 49 49 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 50 50 51 INTEGER , PARAMETER :: jpfld = 9 ! maximum number of files to read52 51 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 53 52 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point … … 59 58 INTEGER , PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 60 59 INTEGER , PARAMETER :: jp_tdif = 9 ! index of tau diff associated to HF tau (N/m2) at T-point 60 #if defined key_orca_r025 61 INTEGER , PARAMETER :: jp_swc = 10 ! index of GEWEX correction for SW radiation at T-point 62 INTEGER , PARAMETER :: jp_lwc = 11 ! index of GEWEX correction for LW radiation at T-point 63 INTEGER , PARAMETER :: jp_prc = 12 ! index of PMWC correction forat T-point 64 INTEGER , PARAMETER :: jpfld = 12 ! maximum number of files to read 65 #else 66 INTEGER , PARAMETER :: jpfld = 9 ! maximum number of files to read 67 #endif 61 68 62 69 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) … … 75 82 LOGICAL :: ln_taudif = .FALSE. ! logical flag to use the "mean of stress module - module of mean stress" data 76 83 REAL(wp) :: rn_pfac = 1. ! multiplication factor for precipitation 84 #if defined key_orca_r025 85 LOGICAL :: ln_printdia= .TRUE. ! logical flag for height of air temp. and hum 86 LOGICAL :: ln_netsw = .TRUE. ! logical flag for height of air temp. and hum 87 LOGICAL :: ln_core_graceopt=.FALSE., ln_core_spinup=.FALSE. 88 LOGICAL :: ln_gwxc = .TRUE. 89 LOGICAL :: ln_corad_antar =.FALSE., ln_corad_arc =.FALSE. , ln_cotair_arc = .FALSE. 90 LOGICAL :: ln_coprecip =.FALSE. 91 REAL(wp) :: rn_qns_bias = 0._wp ! heat flux bias 92 93 #endif 77 94 78 95 !! * Substitutions … … 117 134 !! - emp, emps evaporation minus precipitation 118 135 !!---------------------------------------------------------------------- 136 #if defined key_orca_r025 && key_lim2 137 USE ice_2 138 #endif 119 139 INTEGER, INTENT(in) :: kt ! ocean time step 120 140 !! … … 122 142 INTEGER :: ifpr ! dummy loop indice 123 143 INTEGER :: jfld ! dummy loop arguments 144 INTEGER :: ji, jj 124 145 !! 125 146 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files … … 128 149 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 129 150 TYPE(FLD_N) :: sn_tdif ! " " 151 #if defined key_orca_r025 152 TYPE(FLD_N) :: sn_swc, sn_lwc ! " " 153 TYPE(FLD_N) :: sn_prc 154 INTEGER :: iter_shapiro = 250 155 REAL :: zzlat, zzlat1, zzlat2, zfrld, ztmp 156 REAL(wp), DIMENSION(jpi,jpj):: xyt,z_qsr,z_qlw,z_qsr1,z_qlw1,z_tair 157 REAL(wp), DIMENSION(jpi,jpj):: zqsr_lr, zqsr_hr, zqlw_lr, zqlw_hr, zprec_hr, zprec_lr 158 CHARACTER(len=20) :: c_kind='ORCA_GLOB' 159 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 160 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 161 & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif, & 162 & sn_swc , sn_lwc , sn_prc , ln_gwxc, & 163 & ln_corad_antar, ln_corad_arc, ln_cotair_arc, ln_coprecip , & 164 & rn_qns_bias, ln_printdia, ln_netsw, ln_core_graceopt,ln_core_spinup 165 !!--------------------------------------------------------------------- 166 #else 130 167 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 131 168 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 132 169 & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif 133 170 !!--------------------------------------------------------------------- 171 #endif 134 172 135 173 ! ! ====================== ! … … 151 189 sn_snow = FLD_N( 'snow' , -1 , 'snow' , .true. , .false. , 'yearly' , '' , '' ) 152 190 sn_tdif = FLD_N( 'taudif' , 24 , 'taudif' , .true. , .false. , 'yearly' , '' , '' ) 191 #if defined key_orca_r025 192 sn_swc = FLD_N( 'swc' , 24 , 'swc' , .true. , .false. , 'yearly' , '' , '' ) 193 sn_lwc = FLD_N( 'lwc' , 24 , 'lwc' , .true. , .false. , 'yearly' , '' , '' ) 194 sn_prc = FLD_N( 'prc' , 24 , 'prc' , .true. , .false. , 'yearly' , '' , '' ) 195 #endif 153 196 ! 154 197 REWIND( numnam ) ! read in namlist namsbc_core … … 171 214 lhftau = ln_taudif ! do we use HF tau information? 172 215 jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 216 #if defined key_orca_r025 217 slf_i(jp_swc ) = sn_swc 218 slf_i(jp_lwc ) = sn_lwc 219 slf_i(jp_prc ) = sn_prc 220 IF( .NOT. ln_gwxc ) jfld = jfld - 2 221 IF( .NOT. ln_coprecip ) jfld = jfld - 1 222 #endif 173 223 ! 174 224 ALLOCATE( sf(jfld), STAT=ierror ) ! set sf structure … … 185 235 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 186 236 187 ! ! surface ocean fluxes computed with CLIO bulk formulea 188 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 237 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 238 239 #if defined key_orca_r025 240 ! Introduce ERA-Interim filtering and correction 241 242 IF( ln_gwxc ) THEN 243 244 call Shapiro_1D(sf(jp_qsr)%fnow(:,:,1),iter_shapiro, c_kind, zqsr_lr) 245 zqsr_hr(:,:)=sf(jp_qsr)%fnow(:,:,1)-zqsr_lr(:,:) ! We get large scale and small scale 246 247 call Shapiro_1D(sf(jp_qlw)%fnow(:,:,1),iter_shapiro, c_kind, zqlw_lr) 248 zqlw_hr(:,:)=sf(jp_qlw)%fnow(:,:,1)-zqlw_lr(:,:) ! We get large scale and small scale 249 250 z_qsr1(:,:)=zqsr_lr(:,:)*sf(jp_swc)%fnow(:,:,1) + zqsr_hr(:,:) 251 z_qlw1(:,:)=zqlw_lr(:,:)*sf(jp_lwc)%fnow(:,:,1) + zqlw_hr(:,:) 252 253 DO jj=1,jpj 254 DO ji=1,jpi 255 z_qsr1(ji,jj)=max(z_qsr1(ji,jj),0.0) 256 z_qlw1(ji,jj)=max(z_qlw1(ji,jj),0.0) 257 END DO 258 END DO 259 260 ENDIF 261 262 IF( ln_coprecip ) THEN 263 264 call Shapiro_1D(sf(jp_prec)%fnow(:,:,1),iter_shapiro,c_kind,zprec_lr) 265 zprec_hr(:,:)=sf(jp_prec)%fnow(:,:,1)-zprec_lr(:,:) ! We get large scale and small scale 266 267 DO jj=1,jpj 268 DO ji=1,jpi 269 IF( zprec_lr(ji,jj) .GT. 0._wp ) THEN 270 ztmp = LOG( ( 1000._wp + sf(jp_prc)%fnow(ji,jj,1) ) * EXP( zprec_lr(ji,jj) ) / 1000._wp ) 271 sf(jp_prec)%fnow(ji,jj,1) = max(ztmp+zprec_hr(ji,jj),0.0) 272 ENDIF 273 END DO 274 END DO 275 276 ENDIF 277 278 IF ( ln_corad_antar ) THEN ! correction of SW and LW in the Southern Ocean 279 280 z_qsr(:,:)=0.8*z_qsr1(:,:) 281 z_qlw(:,:)=1.1*z_qlw1(:,:) 282 xyt(:,:) = 0.e0 283 zzlat1 = -65. 284 zzlat2 = -60. 285 DO jj = 1, jpj 286 DO ji = 1, jpi 287 zzlat = gphit(ji,jj) 288 IF ( zzlat >= zzlat1 .AND. zzlat <= zzlat2 ) THEN 289 xyt(ji,jj) = (zzlat2-zzlat)/(zzlat2-zzlat1) 290 ELSE IF ( zzlat < zzlat1 ) THEN 291 xyt(ji,jj) = 1 292 ENDIF 293 END DO 294 END DO 295 z_qsr1(:,:)=z_qsr(:,:)*xyt(:,:)+(1.0-xyt(:,:))*z_qsr1(:,:) 296 z_qlw1(:,:)=z_qlw(:,:)*xyt(:,:)+(1.0-xyt(:,:))*z_qlw1(:,:) 297 298 ENDIF 299 300 IF ( ln_corad_arc ) THEN ! correction of SW in the Arctic Ocean 301 302 z_qsr(:,:)=0.7*z_qsr1(:,:) 303 xyt(:,:) = 0.e0 304 zzlat1 = 78. 305 zzlat2 = 82. 306 DO jj = 1, jpj 307 DO ji = 1, jpi 308 zzlat = gphit(ji,jj) 309 IF ( zzlat >= zzlat1 .AND. zzlat <= zzlat2 ) THEN 310 xyt(ji,jj) = (zzlat-zzlat1)/(zzlat2-zzlat1) 311 ELSE IF ( zzlat > zzlat2 ) THEN 312 xyt(ji,jj) = 1 313 ENDIF 314 END DO 315 END DO 316 z_qsr1(:,:)=z_qsr(:,:)*xyt(:,:)+(1.0-xyt(:,:))*z_qsr1(:,:) 317 318 ENDIF 319 320 sf(jp_qsr)%fnow(:,:,1)=z_qsr1(:,:) 321 sf(jp_qlw)%fnow(:,:,1)=z_qlw1(:,:) 322 323 #if defined key_lim2 324 IF ( ln_cotair_arc ) THEN ! correction of Air Temperature in the Arctic Ocean 325 326 z_tair(:,:)=sf(jp_tair)%fnow(:,:,1) - 2.0 327 xyt(:,:) = 0.e0 ; zzlat1 = 78. ; zzlat2 = 82. 328 DO jj = 1, jpj 329 DO ji = 1, jpi 330 zzlat = gphit(ji,jj) ; zfrld=frld(ji,jj) 331 IF ( zzlat >= zzlat1 .AND. zzlat <= zzlat2 .AND. zfrld < 0.85 ) THEN 332 xyt(ji,jj) = (zzlat-zzlat1)/(zzlat2-zzlat1) 333 ELSE IF ( zzlat > zzlat2 .AND. zfrld < 0.85 ) THEN 334 xyt(ji,jj) = 1 335 ENDIF 336 END DO 337 END DO 338 sf(jp_tair)%fnow(:,:,1)=z_tair(:,:)*xyt(:,:)+(1.0-xyt(:,:))*sf(jp_tair)%fnow(:,:,1) 339 340 ENDIF 341 #endif 342 343 #endif 344 CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) ! surface ocean fluxes computed with CLIO bulk formule 345 346 ENDIF 189 347 190 348 #if defined key_cice … … 332 490 IF( lhftau ) THEN 333 491 !CDIR COLLAPSE 492 #if defined key_orca_r025 493 ! Changed!!! Multiply by QSCAT correction 494 zwnd_i(:,:) = zwnd_i(:,:) * sf(jp_tdif)%fnow(:,:,1) 495 zwnd_j(:,:) = zwnd_j(:,:) * sf(jp_tdif)%fnow(:,:,1) 496 #endif 334 497 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 335 498 ENDIF … … 946 1109 ! 947 1110 END FUNCTION psi_h 948 1111 1112 SUBROUTINE Shapiro_1D(rla_varin,id_np, cd_overlap, rlpa_varout) !GIG 1113 !!===================================================================== 1114 !! 1115 !! Description: This function applies a 1D Shapiro filter 1116 !! (3 points filter) horizontally to a 2D field 1117 !! in regular grid 1118 !! Arguments : 1119 !! rla_varin : Input variable to filter 1120 !! zla_mask : Input mask variable 1121 !! id_np : Number of Shapiro filter iterations 1122 !! cd_overlap : Logical argument for periodical condition 1123 !! (global ocean case) 1124 !! rlpa_varout : Output filtered variable 1125 !! 1126 !! History : 08/2009 S. CAILLEAU : from 1st version of N. FERRY 1127 !! 09/2009 C. REGNIER : Corrections 1128 !! 1129 !!===================================================================== 1130 IMPLICIT NONE 1131 INTEGER, INTENT(IN) :: id_np 1132 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: rla_varin !GIG 1133 CHARACTER(len=20), INTENT(IN) :: cd_overlap !GIG 1134 REAL(wp), DIMENSION(jpi,jpj), INTENT(OUT) :: rlpa_varout !GIG 1135 1136 REAL(wp), DIMENSION(jpi,jpj) :: rlpa_varout_tmp 1137 REAL, PARAMETER :: rl_alpha = 1./2. ! fixed stability coefficient (isotrope case) 1138 REAL, parameter :: rap_aniso_diff_XY=2.25 ! anisotrope case 1139 REAL :: alphax,alphay, znum, zden,test 1140 INTEGER :: ji, jj, jn, nn 1141 ! 1142 !! rap_aniso_diff_XY=2.25 : valeur trouvée empiriquement pour 140 itération po% ur le filtre de Shapiro et 1143 !! pour un rapport d'anisotopie de 1.5 : on filtre de plus rapidement en x qu'eny. 1144 !------------------------------------------------------------------------------ 1145 ! 1146 ! Loop on several filter iterations 1147 1148 ! Global ocean case 1149 IF (( cd_overlap == 'MERCA_GLOB' ) .OR. & 1150 ( cd_overlap == 'REGULAR_GLOB' ) .OR. & 1151 ( cd_overlap == 'ORCA_GLOB' )) THEN 1152 rlpa_varout(:,:) = rla_varin(:,:) 1153 rlpa_varout_tmp(:,:) = rlpa_varout(:,:) 1154 ! 1155 1156 alphax=1./2. 1157 alphay=1./2. 1158 ! Dx/Dy=rap_aniso_diff_XY , D_ = vitesse de diffusion 1159 ! 140 passes du fitre, Lx/Ly=1.5, le rap_aniso_diff_XY correspondant est: 1160 IF ( rap_aniso_diff_XY .GE. 1. ) alphay=alphay/rap_aniso_diff_XY 1161 IF ( rap_aniso_diff_XY .LT. 1. ) alphax=alphax*rap_aniso_diff_XY 1162 1163 DO jn = 1,id_np ! number of passes of the filter 1164 DO ji = 2,jpim1 1165 DO jj = 2,jpjm1 1166 ! We crop on the coast 1167 znum = rlpa_varout_tmp(ji,jj) & 1168 + 0.25*alphax*(rlpa_varout_tmp(ji-1,jj )-rlpa_varout_tmp(ji,jj))*tmask(ji-1,jj ,1) & 1169 + 0.25*alphax*(rlpa_varout_tmp(ji+1,jj )-rlpa_varout_tmp(ji,jj))*tmask(ji+1,jj ,1) & 1170 + 0.25*alphay*(rlpa_varout_tmp(ji ,jj-1)-rlpa_varout_tmp(ji,jj))*tmask(ji ,jj-1,1) & 1171 + 0.25*alphay*(rlpa_varout_tmp(ji ,jj+1)-rlpa_varout_tmp(ji,jj))*tmask(ji ,jj+1,1) 1172 rlpa_varout(ji,jj)=znum*tmask(ji,jj,1)+rla_varin(ji,jj)*(1.-tmask(ji,jj,1)) 1173 ENDDO ! end loop ji 1174 ENDDO ! end loop jj 1175 ! 1176 ! 1177 ! Periodical condition in case of cd_overlap (global ocean) 1178 ! - on a mercator projection grid we consider that singular point at poles 1179 ! are a mean of the values at points of the previous latitude 1180 ! - on ORCA and regular grid we copy the values at points of the previous latitude 1181 IF ( cd_overlap == 'MERCAT_GLOB' ) THEN 1182 !GIG case unchecked 1183 rlpa_varout(1,1) = SUM(rlpa_varout(:,2)) / jpi 1184 rlpa_varout(jpi,jpj) = SUM(rlpa_varout(:,jpj-1)) / jpi 1185 ELSE 1186 call lbc_lnk(rlpa_varout, 'T', 1.) ! Boundary condition 1187 ENDIF 1188 rlpa_varout_tmp(:,:) = rlpa_varout(:,:) 1189 ENDDO ! end loop jn 1190 ENDIF 1191 1192 ! 1193 END SUBROUTINE Shapiro_1D 1194 949 1195 !!====================================================================== 950 1196 END MODULE sbcblk_core -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r3294 r3398 58 58 REAL(wp) :: r1_rau0 ! = 1 / rau0 59 59 60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read)61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read)62 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read)60 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read) 61 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read) 62 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) 63 63 64 64 !! * Substitutions -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
r2528 r3398 42 42 !!--------------------------------------------------------------------- 43 43 LOGICAL, PUBLIC, PARAMETER :: lk_my_trc = .TRUE. !: PTS flag 44 INTEGER, PUBLIC, PARAMETER :: jp_my_trc = 2!: number of PTS tracers44 INTEGER, PUBLIC, PARAMETER :: jp_my_trc = 1 !: number of PTS tracers 45 45 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_2d = 0 !: additional 2d output arrays ('key_trc_diaadd') 46 46 INTEGER, PUBLIC, PARAMETER :: jp_my_trc_3d = 0 !: additional 3d output arrays ('key_trc_diaadd') … … 49 49 ! assign an index in trc arrays for each PTS prognostic variables 50 50 INTEGER, PUBLIC, PARAMETER :: jpmyt1 = jp_lm + 1 !: 1st MY_TRC tracer 51 INTEGER, PUBLIC, PARAMETER :: jpmyt2 = jp_lm + 2 !: 2nd MY_TRC tracer52 51 53 52 #else -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r3294 r3398 62 62 END WHERE 63 63 64 WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80))65 trn(:,:,1,jpmyt2) = 1._wp66 trb(:,:,1,jpmyt2) = 1._wp67 tra(:,:,1,jpmyt2) = 0._wp68 END WHERE69 70 64 IF( l_trdtrc ) THEN ! Save the trends in the ixed layer 71 65 DO jn = jp_myt0, jp_myt1 -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r3294 r3398 82 82 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 83 83 84 #if ! defined key_pisces 85 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 86 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 87 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 88 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 84 IF( ln_top_euler) THEN 85 r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping) 86 ELSE 87 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 88 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 89 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 90 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 91 ENDIF 89 92 ENDIF 90 #else91 r2dt(:) = rdttrc(:) ! = rdttrc (for PISCES use Euler time stepping)92 #endif93 93 94 94 ! ! effective transport -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r3294 r3398 81 81 NAMELIST/namtrc_rad/ ln_trcrad 82 82 #if defined key_trcdmp 83 NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, &83 NAMELIST/namtrc_dmp/ ln_trcdmp, nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, & 84 84 & rn_bot_tr , rn_dep_tr , nn_file_tr 85 85 #endif … … 156 156 WRITE(numout,*) '~~~~~~~' 157 157 WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter' 158 WRITE(numout,*) ' add a damping term or not ln_trcdmp = ', ln_trcdmp 158 159 WRITE(numout,*) ' tracer damping option nn_hdmp_tr = ', nn_hdmp_tr 159 160 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r3294 r3398 73 73 IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options 74 74 75 #if ! defined key_pisces 76 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 77 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 78 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 79 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 75 IF( ln_top_euler) THEN 76 r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping) 77 ELSE 78 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 79 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 80 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 81 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 82 ENDIF 80 83 ENDIF 81 #else82 r2dt(:) = rdttrc(:) ! = rdttrc (for PISCES use Euler time stepping)83 #endif84 84 85 85 IF( l_trdtrc ) THEN -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/trc.F90
r3294 r3398 25 25 INTEGER, PUBLIC :: numnat !: logicla unit for the passive tracer NAMELIST 26 26 INTEGER, PUBLIC :: numstr !: logical unit for tracer statistics 27 LOGICAL, PUBLIC :: ln_top_euler !: boolean term for euler integration in the first timestep 27 28 28 29 !! passive tracers fields (before,now,after) … … 68 69 CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcln !: trccer field long name 69 70 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcun !: tracer unit 70 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ini !: Initialisation from data input file71 71 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_wri !: save the tracer or not 72 72 … … 76 76 CHARACTER(len = 20) :: units !: unit 77 77 END TYPE DIAG 78 79 !! information for inputs 80 !! -------------------------------------------------- 81 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ini !: Initialisation from data input file 82 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_obc !: Use open boundary condition data 83 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 84 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 78 85 79 86 !! additional 2D/3D outputs namelist -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r3319 r3398 60 60 !! 61 61 NAMELIST/namtrc/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, & 62 & cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, ln_trcdmp 62 & cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, ln_trcdmp, & 63 & ln_top_euler 63 64 #if defined key_trdmld_trc || defined key_trdtrc 64 65 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & … … 79 80 nn_dttrc = 1 ! default values 80 81 nn_writetrc = 10 82 ln_top_euler = .FALSE. 81 83 ln_rsttr = .FALSE. 82 84 nn_rsttr = 0 … … 120 122 WRITE(numout,*) ' Read inputs data from file (y/n) ln_trcdta = ', ln_trcdta 121 123 WRITE(numout,*) ' Damping of passive tracer (y/n) ln_trcdmp = ', ln_trcdmp 124 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 122 125 WRITE(numout,*) ' ' 123 126 DO jn = 1, jptra -
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r3294 r3398 29 29 USE sbc_oce ! surface boundary condition: ocean 30 30 USE bdy_oce 31 #if defined key_obc 32 USE obc_oce, ONLY: obctmsk 33 #endif 31 34 #if defined key_agrif 32 35 USE agrif_opa_update
Note: See TracChangeset
for help on using the changeset viewer.