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 3512 – NEMO

Changeset 3512


Ignore:
Timestamp:
2012-10-21T18:55:19+02:00 (12 years ago)
Author:
vichi
Message:

Restored the default sbcblk_core.F90 and housekeeping

Location:
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM
Files:
3 deleted
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3398 r3512  
    4949   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module 
    5050 
     51   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
    5152   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    5253   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
     
    5859   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    5960   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 
    6861    
    6962   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
     
    8275   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data 
    8376   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 
    9477 
    9578   !! * Substitutions 
     
    134117      !!              - emp, emps   evaporation minus precipitation 
    135118      !!---------------------------------------------------------------------- 
    136 #if defined key_orca_r025 && key_lim2 
    137       USE ice_2 
    138 #endif 
    139119      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    140120      !! 
     
    142122      INTEGER  ::   ifpr     ! dummy loop indice 
    143123      INTEGER  ::   jfld     ! dummy loop arguments 
    144       INTEGER  ::   ji, jj 
    145124      !! 
    146125      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
     
    149128      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    150129      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 
    167130      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
    168131         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    169132         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif 
    170133      !!--------------------------------------------------------------------- 
    171 #endif 
    172134 
    173135      !                                         ! ====================== ! 
     
    189151         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
    190152         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 
    196153         ! 
    197154         REWIND( numnam )                          ! read in namlist namsbc_core 
     
    214171         lhftau = ln_taudif                        ! do we use HF tau information? 
    215172         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 
    223173         ! 
    224174         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure 
     
    235185      CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step 
    236186 
    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 
     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 ) 
    347189 
    348190#if defined key_cice 
     
    490332      IF( lhftau ) THEN  
    491333!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 
    497334         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    498335      ENDIF 
     
    1109946      ! 
    1110947    END FUNCTION psi_h 
    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  
     948   
    1195949   !!====================================================================== 
    1196950END MODULE sbcblk_core 
Note: See TracChangeset for help on using the changeset viewer.