New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3398 – NEMO

Changeset 3398


Ignore:
Timestamp:
2012-05-22T09:37:43+02:00 (12 years ago)
Author:
vichi
Message:

NEMOBFM update to last revision ( r5b59a317) in CMCC

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_SRC 
    21GYRE_LOBSTER OPA_SRC TOP_SRC 
    32ORCA2_LIM3 OPA_SRC LIM_SRC_3 
     
    76ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    87ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     8GYRE OPA_SRC 
     9PELAGOS025 OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     10GYRE_BFM OPA_SRC TOP_SRC 
     11PELAGOS OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90

    r2281 r3398  
    678678              io_sl(v_d_ul(iv))=it 
    679679            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 
    680688          ENDIF 
    681689        ENDIF 
     
    16211629END SUBROUTINE flrb_rg 
    16221630!=== 
     1631SUBROUTINE 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 
     1781END SUBROUTINE 
     1782!=== 
    16231783!-------------------- 
    16241784END PROGRAM flio_rbld 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3294 r3398  
    831831         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
    832832         sdf(jf)%vcomp   = sdf_n(jf)%vcomp 
     833         sdf(jf)%rotn    = .FALSE. 
    833834      END DO 
    834835 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3294 r3398  
    4949   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5050 
    51    INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
    5251   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    5352   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
     
    5958   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    6059   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 
    6168    
    6269   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
     
    7582   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data 
    7683   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 
    7794 
    7895   !! * Substitutions 
     
    117134      !!              - emp, emps   evaporation minus precipitation 
    118135      !!---------------------------------------------------------------------- 
     136#if defined key_orca_r025 && key_lim2 
     137      USE ice_2 
     138#endif 
    119139      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    120140      !! 
     
    122142      INTEGER  ::   ifpr     ! dummy loop indice 
    123143      INTEGER  ::   jfld     ! dummy loop arguments 
     144      INTEGER  ::   ji, jj 
    124145      !! 
    125146      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
     
    128149      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    129150      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 
    130167      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
    131168         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    132169         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif 
    133170      !!--------------------------------------------------------------------- 
     171#endif 
    134172 
    135173      !                                         ! ====================== ! 
     
    151189         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    152190         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 
    153196         ! 
    154197         REWIND( numnam )                          ! read in namlist namsbc_core 
     
    171214         lhftau = ln_taudif                        ! do we use HF tau information? 
    172215         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 
    173223         ! 
    174224         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure 
     
    185235      CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step 
    186236 
    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 
    189347 
    190348#if defined key_cice 
     
    332490      IF( lhftau ) THEN  
    333491!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 
    334497         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    335498      ENDIF 
     
    9461109      ! 
    9471110    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 
    9491195   !!====================================================================== 
    9501196END MODULE sbcblk_core 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3294 r3398  
    5858   REAL(wp) ::   r1_rau0   ! = 1 / rau0  
    5959 
    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)   
    6363  
    6464   !! * Substitutions   
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r2528 r3398  
    4242   !!--------------------------------------------------------------------- 
    4343   LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .TRUE.   !: PTS flag  
    44    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  2       !: number of PTS tracers 
     44   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  1       !: number of PTS tracers 
    4545   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: additional 2d output arrays ('key_trc_diaadd') 
    4646   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: additional 3d output arrays ('key_trc_diaadd') 
     
    4949   ! assign an index in trc arrays for each PTS prognostic variables 
    5050   INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lm + 1     !: 1st MY_TRC tracer 
    51    INTEGER, PUBLIC, PARAMETER ::   jpmyt2 = jp_lm + 2     !: 2nd MY_TRC tracer 
    5251 
    5352#else 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r3294 r3398  
    6262      END WHERE 
    6363 
    64       WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80)) 
    65         trn(:,:,1,jpmyt2) = 1._wp 
    66         trb(:,:,1,jpmyt2) = 1._wp 
    67         tra(:,:,1,jpmyt2) = 0._wp 
    68       END WHERE 
    69  
    7064      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 
    7165          DO jn = jp_myt0, jp_myt1 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r3294 r3398  
    8282      IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    8383 
    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 
    8992      ENDIF 
    90 #else 
    91       r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping) 
    92 #endif 
    9393 
    9494      !                                                   ! effective transport 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90

    r3294 r3398  
    8181      NAMELIST/namtrc_rad/ ln_trcrad 
    8282#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, & 
    8484        &                  rn_bot_tr , rn_dep_tr , nn_file_tr 
    8585#endif 
     
    156156         WRITE(numout,*) '~~~~~~~' 
    157157         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter' 
     158         WRITE(numout,*) '      add a damping term or not      ln_trcdmp = ', ln_trcdmp 
    158159         WRITE(numout,*) '      tracer damping option          nn_hdmp_tr = ', nn_hdmp_tr 
    159160         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  
    7373      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options 
    7474 
    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 
    8083      ENDIF 
    81 #else 
    82       r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping) 
    83 #endif 
    8484 
    8585      IF( l_trdtrc )  THEN 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r3294 r3398  
    2525   INTEGER, PUBLIC                                                 ::   numnat        !: logicla unit for the passive tracer NAMELIST 
    2626   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics 
     27   LOGICAL, PUBLIC                                                 ::   ln_top_euler  !: boolean term for euler integration in the first timestep 
    2728 
    2829   !! passive tracers fields (before,now,after) 
     
    6869   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name 
    6970   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit 
    70    LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file 
    7171   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not 
    7272 
     
    7676      CHARACTER(len = 20)  :: units    !: unit 
    7777   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 
    7885 
    7986   !! additional 2D/3D outputs namelist 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r3319 r3398  
    6060      !! 
    6161      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 
    6364#if defined key_trdmld_trc  || defined key_trdtrc 
    6465      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     
    7980      nn_dttrc      = 1                 ! default values 
    8081      nn_writetrc   = 10  
     82      ln_top_euler  = .FALSE. 
    8183      ln_rsttr      = .FALSE. 
    8284      nn_rsttr      =  0 
     
    120122         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
    121123         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 
    122125         WRITE(numout,*) ' ' 
    123126         DO jn = 1, jptra 
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r3294 r3398  
    2929   USE sbc_oce         ! surface boundary condition: ocean 
    3030   USE bdy_oce 
     31#if defined key_obc 
     32   USE obc_oce, ONLY: obctmsk 
     33#endif 
    3134#if defined key_agrif 
    3235   USE agrif_opa_update 
Note: See TracChangeset for help on using the changeset viewer.