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 11939 for branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM – NEMO

Ignore:
Timestamp:
2019-11-20T17:32:11+01:00 (4 years ago)
Author:
dcarneir
Message:

Changing GO6 package to include sea ice thickness DA

Location:
branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM/CONFIG/SHARED/namelist_ref

    r11559 r11939  
    12981298    ln_asmdin      = .false. !  Logical switch for Direct Initialization (DI) 
    12991299    ln_asmiau      = .false. !  Logical switch for Incremental Analysis Updating (IAU) 
    1300     ln_seaiceinc   = .false. !  Logical switch for applying sea ice increments 
     1300    ln_seaiceinc   = .false. !  Logical switch for applying sea ice concentration increments 
     1301    ln_sitinc      = .false. !  Logical switch for applying sea ice thickness increments 
    13011302    ln_phytobal    = .false. !  Logical switch for phytoplankton multivariate balancing 
    13021303    ln_slchltotinc = .false. !  Logical switch for applying slchltot increments 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r10302 r11939  
    2121   !!   dyn_asm_inc    : Apply the dynamic (u and v) increments 
    2222   !!   ssh_asm_inc    : Apply the SSH increment 
    23    !!   seaice_asm_inc : Apply the seaice increment 
     23   !!   seaice_asm_inc : Apply the sea ice concentration increment 
     24   !!   sit_asm_inc    : Apply the sea ice thickness increment 
    2425   !!---------------------------------------------------------------------- 
    2526   USE wrk_nemo         ! Memory Allocation 
     
    4142#if defined key_cice && defined key_asminc 
    4243   USE sbc_ice, ONLY : & ! CICE Ice model variables 
    43    & ndaice_da, nfresh_da, nfsalt_da 
     44   & ndaice_da, ndsit_da, nfresh_da, nfsalt_da 
    4445#endif 
    4546   USE sbc_oce          ! Surface boundary condition variables. 
     
    5455   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
    5556   PUBLIC   ssh_asm_inc    !: Apply the SSH increment 
    56    PUBLIC   seaice_asm_inc !: Apply the seaice increment 
     57   PUBLIC   seaice_asm_inc !: Apply the seaice concentration increment 
     58   PUBLIC   sit_asm_inc    !: Apply the seaice thickness increment 
    5759   PUBLIC   bgc_asm_inc    !: Apply the biogeochemistry increments 
    5860 
     
    6870   LOGICAL, PUBLIC :: ln_dyninc = .FALSE.      !: No dynamics (u and v) assimilation increments 
    6971   LOGICAL, PUBLIC :: ln_sshinc = .FALSE.      !: No sea surface height assimilation increment 
    70    LOGICAL, PUBLIC :: ln_seaiceinc             !: No sea ice concentration increment 
     72   LOGICAL, PUBLIC :: ln_seaiceinc = .FALSE.   !: No sea ice concentration increment 
     73   LOGICAL, PUBLIC :: ln_sitinc = .FALSE.      !: No sea ice thickness increment 
    7174   LOGICAL, PUBLIC :: lk_bgcinc = .FALSE.      !: No biogeochemistry increments 
    7275   LOGICAL, PUBLIC :: ln_salfix = .FALSE.      !: Apply minimum salinity check 
     
    9497   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment 
    9598   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   seaice_bkginc         ! Increment to the background sea ice conc 
     99   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   sit_bkginc            ! Increment to the background sea ice thickness 
    96100 
    97101   !! * Substitutions 
     
    147151         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    148152         &                 ln_salfix, salfixmin, nn_divdmp,                & 
    149          &                 ln_seaiceinc, ln_temnofreeze,                   & 
     153         &                 ln_seaiceinc, ln_sitinc, ln_temnofreeze,        & 
    150154         &                 mld_choice_bgc, rn_maxchlinc 
    151155      !!---------------------------------------------------------------------- 
     
    155159      !----------------------------------------------------------------------- 
    156160      ln_seaiceinc = .FALSE. 
     161      ln_sitinc = .FALSE. 
    157162      ln_temnofreeze = .FALSE. 
    158163 
     
    178183         WRITE(numout,*) '      Logical switch for applying SSH increments               ln_sshinc = ', ln_sshinc 
    179184         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin 
    180          WRITE(numout,*) '      Logical switch for applying sea ice increments        ln_seaiceinc = ', ln_seaiceinc 
     185         WRITE(numout,*) '      Logical switch for applying SIC increments               ln_seaiceinc = ', ln_seaiceinc 
     186         WRITE(numout,*) '      Logical switch for applying SIT increments               ln_sitinc = ', ln_sitinc 
    181187         WRITE(numout,*) '      Logical switch for phytoplankton balancing             ln_phytobal = ', ln_phytobal 
    182188         WRITE(numout,*) '      Logical switch for applying slchltot increments     ln_slchltotinc = ', ln_slchltotinc 
     
    264270      IF (      ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) & 
    265271         & .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ).OR. & 
    266          &        ( lk_bgcinc ) )) & 
     272         &        ( ln_sitinc ).OR.( lk_bgcinc ) )) & 
    267273         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 
    268          &                ' ln_(bgc-variable)inc is set to .true.', & 
     274         &                ' ln_sitinc and ln_(bgc-variable)inc is set to .true.', & 
    269275         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', & 
    270276         &                ' Inconsistent options') 
     
    275281 
    276282      IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ).AND.( .NOT. ln_seaiceinc ) & 
    277          & .AND.( .NOT. lk_bgcinc ) )  & 
     283         & .AND.( .NOT. ln_sitinc ).AND.( .NOT. lk_bgcinc ) )  & 
    278284         & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 
    279          &                ' ln_(bgc-variable)inc are set to .false. :', & 
     285         &                ' ln_sitinc and ln_(bgc-variable)inc are set to .false. :', & 
    280286         &                ' The assimilation increments are not applied') 
    281287 
     
    383389      ALLOCATE( ssh_bkginc(jpi,jpj)   ) 
    384390      ALLOCATE( seaice_bkginc(jpi,jpj)) 
     391      ALLOCATE( sit_bkginc(jpi,jpj)   ) 
    385392#if defined key_asminc 
    386393      ALLOCATE( ssh_iau(jpi,jpj)      ) 
     
    392399      ssh_bkginc(:,:) = 0.0 
    393400      seaice_bkginc(:,:) = 0.0 
     401      sit_bkginc(:,:) = 0.0 
    394402#if defined key_asminc 
    395403      ssh_iau(:,:)    = 0.0 
    396404#endif 
    397405      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) & 
    398          &  .OR.( lk_bgcinc ) ) THEN 
     406         &  .OR.( ln_sitinc ).OR.( lk_bgcinc ) ) THEN 
    399407 
    400408         !-------------------------------------------------------------------- 
     
    459467            ! to allow for differences in masks 
    460468            WHERE( ABS( ssh_bkginc(:,:) ) > 1.0e+10 ) ssh_bkginc(:,:) = 0.0 
     469         ENDIF 
     470 
     471         IF ( ln_sitinc ) THEN 
     472            CALL iom_get( inum, jpdom_autoglo, 'bckinsit', sit_bkginc, 1 ) 
     473            ! Apply the masks 
     474            sit_bkginc(:,:) = sit_bkginc(:,:) * tmask(:,:,1) 
     475            ! Set missing increments to 0.0 rather than 1e+20 
     476            ! to allow for differences in masks 
     477            WHERE( ABS( sit_bkginc(:,:) ) > 1.0e+10 ) sit_bkginc(:,:) = 0.0 
    461478         ENDIF 
    462479 
     
    827844      ! Perhaps the following call should be in step 
    828845      IF   ( ln_seaiceinc  )   CALL seaice_asm_inc ( kt )   ! apply sea ice concentration increment 
     846      IF   ( ln_sitinc  )      CALL sit_asm_inc ( kt )      ! apply sea ice thickness increment 
    829847      ! 
    830848   END SUBROUTINE tra_asm_inc 
     
    9881006   END SUBROUTINE ssh_asm_inc 
    9891007 
     1008   SUBROUTINE sit_asm_inc( kt, kindic ) 
     1009      !!---------------------------------------------------------------------- 
     1010      !!                    ***  ROUTINE sit_asm_inc  *** 
     1011      !!           
     1012      !! ** Purpose : Apply the sea ice thickness assimilation increment. 
     1013      !! 
     1014      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
     1015      !! 
     1016      !! ** Action  :  
     1017      !! 
     1018      !!---------------------------------------------------------------------- 
     1019      IMPLICIT NONE 
     1020      ! 
     1021      INTEGER, INTENT(in)           ::   kt   ! Current time step 
     1022      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation 
     1023      ! 
     1024      INTEGER  ::   it 
     1025      REAL(wp) ::   zincwgt   ! IAU weight for current time step 
     1026! #if defined key_lim2 
     1027!       REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc  ! LIM 
     1028!       REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres 
     1029!       !!THICKNESS INCS NOT SET UP FOR LIM 
     1030! #endif 
     1031      !!---------------------------------------------------------------------- 
     1032 
     1033      IF ( ln_asmiau ) THEN 
     1034 
     1035         !-------------------------------------------------------------------- 
     1036         ! Incremental Analysis Updating 
     1037         !-------------------------------------------------------------------- 
     1038 
     1039         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN 
     1040 
     1041            it = kt - nit000 + 1 
     1042            zincwgt = wgtiau(it)      ! IAU weight for the current time step  
     1043            ! note this is not a tendency so should not be divided by rdt (as with the tracer and other increments) 
     1044            ! EF: Actually CICE is expecting a tendency so is divided by rdt below 
     1045 
     1046            IF(lwp) THEN 
     1047               WRITE(numout,*)  
     1048               WRITE(numout,*) 'sit_asm_inc : sea ice thick IAU at time step = ', & 
     1049                  &  kt,' with IAU weight = ', wgtiau(it) 
     1050               WRITE(numout,*) '~~~~~~~~~~~~' 
     1051            ENDIF 
     1052 
     1053            ! Sea-ice : LIM-3 case (to add) 
     1054 
     1055! #if defined key_lim2 
     1056!             ! Sea-ice : LIM-2 case (to add if needed) 
     1057!             zofrld (:,:) = frld(:,:) 
     1058!             zohicif(:,:) = hicif(:,:) 
     1059!             ! 
     1060!             frld  = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     1061!             pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     1062!             fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction 
     1063!             ! 
     1064!             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)   ! find out actual sea ice nudge applied 
     1065!             ! 
     1066!             ! Nudge sea ice depth to bring it up to a required minimum depth 
     1067!             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
     1068!                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     1069!             ELSEWHERE 
     1070!                zhicifinc(:,:) = 0.0_wp 
     1071!             END WHERE 
     1072!             ! 
     1073!             ! nudge ice depth 
     1074!             hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 
     1075!             phicif(:,:) = phicif(:,:) + zhicifinc(:,:)        
     1076!             ! 
     1077!             ! seaice salinity balancing (to add) 
     1078! #endif 
     1079 
     1080#if defined key_cice && defined key_asminc 
     1081            ! Sea-ice thickness : CICE case. Pass ice thickness increment tendency into CICE 
     1082            ndsit_da(:,:) = sit_bkginc(:,:) * zincwgt / rdt 
     1083#endif 
     1084 
     1085            IF ( kt == nitiaufin_r ) THEN 
     1086               DEALLOCATE( sit_bkginc ) 
     1087            ENDIF 
     1088 
     1089         ELSE 
     1090 
     1091#if defined key_cice && defined key_asminc 
     1092            ! Sea-ice thickness : CICE case. Zero ice increment tendency into CICE 
     1093            ndsit_da(:,:) = 0.0_wp 
     1094#endif 
     1095 
     1096         ENDIF 
     1097 
     1098      ELSEIF ( ln_asmdin ) THEN 
     1099 
     1100         !-------------------------------------------------------------------- 
     1101         ! Direct Initialization 
     1102         !-------------------------------------------------------------------- 
     1103 
     1104         IF ( kt == nitdin_r ) THEN 
     1105 
     1106            neuler = 0                    ! Force Euler forward step 
     1107 
     1108            ! Sea-ice : LIM-3 case (to add) 
     1109 
     1110! #if defined key_lim2 
     1111!             ! Sea-ice : LIM-2 case (add if needed) 
     1112!             zofrld(:,:)=frld(:,:) 
     1113!             zohicif(:,:)=hicif(:,:) 
     1114!             !  
     1115!             ! Initialize the now fields the background + increment 
     1116!             frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
     1117!             pfrld(:,:) = frld(:,:)  
     1118!             fr_i (:,:) = 1.0_wp - frld(:,:)                ! adjust ice fraction 
     1119!             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)      ! find out actual sea ice nudge applied 
     1120!             ! 
     1121!             ! Nudge sea ice depth to bring it up to a required minimum depth 
     1122!             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
     1123!                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     1124!             ELSEWHERE 
     1125!                zhicifinc(:,:) = 0.0_wp 
     1126!             END WHERE 
     1127!             ! 
     1128!             ! nudge ice depth 
     1129!             hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 
     1130!             phicif(:,:) = phicif(:,:)        
     1131!             ! 
     1132!             ! seaice salinity balancing (to add) 
     1133! #endif 
     1134  
     1135#if defined key_cice && defined key_asminc 
     1136            ! Sea-ice thickness : CICE case. Pass ice thickness increment tendency into CICE 
     1137           ndsit_da(:,:) = sit_bkginc(:,:) / rdt 
     1138#endif 
     1139           IF ( .NOT. PRESENT(kindic) ) THEN 
     1140              DEALLOCATE( sit_bkginc ) 
     1141           END IF 
     1142 
     1143         ELSE 
     1144 
     1145#if defined key_cice && defined key_asminc 
     1146            ! Sea-ice thicnkness : CICE case. Zero ice thickness increment tendency into CICE  
     1147            ndsit_da(:,:) = 0.0_wp 
     1148#endif 
     1149          
     1150         ENDIF 
     1151 
     1152!#if defined defined key_lim2 || defined key_cice 
     1153! 
     1154!            IF (ln_seaicebal ) THEN        
     1155!             !! balancing salinity increments 
     1156!             !! simple case from limflx.F90 (doesn't include a mass flux) 
     1157!             !! assumption is that as ice concentration is reduced or increased 
     1158!             !! the snow and ice depths remain constant 
     1159!             !! note that snow is being created where ice concentration is being increased 
     1160!             !! - could be more sophisticated and 
     1161!             !! not do this (but would need to alter h_snow) 
     1162! 
     1163!             usave(:,:,:)=sb(:,:,:)   ! use array as a temporary store 
     1164! 
     1165!             DO jj = 1, jpj 
     1166!               DO ji = 1, jpi  
     1167!           ! calculate change in ice and snow mass per unit area 
     1168!           ! positive values imply adding salt to the ocean (results from ice formation) 
     1169!           ! fwf : ice formation and melting 
     1170! 
     1171!                 zfons = ( -nfresh_da(ji,jj)*soce + nfsalt_da(ji,jj) )*rdt 
     1172! 
     1173!           ! change salinity down to mixed layer depth 
     1174!                 mld=hmld_kara(ji,jj) 
     1175! 
     1176!           ! prevent small mld 
     1177!           ! less than 10m can cause salinity instability  
     1178!                 IF (mld < 10) mld=10 
     1179! 
     1180!           ! set to bottom of a level  
     1181!                 DO jk = jpk-1, 2, -1 
     1182!                   IF ((mld > gdepw(ji,jj,jk)) .and. (mld < gdepw(ji,jj,jk+1))) THEN  
     1183!                     mld=gdepw(ji,jj,jk+1) 
     1184!                     jkmax=jk 
     1185!                   ENDIF 
     1186!                 ENDDO 
     1187! 
     1188!            ! avoid applying salinity balancing in shallow water or on land 
     1189!            !  
     1190! 
     1191!            ! dsal_ocn (psu kg m^-2) / (kg m^-3 * m) 
     1192! 
     1193!                 dsal_ocn=0.0_wp 
     1194!                 sal_thresh=5.0_wp        ! minimum salinity threshold for salinity balancing 
     1195! 
     1196!                 if (tmask(ji,jj,1) > 0 .AND. tmask(ji,jj,jkmax) > 0 ) & 
     1197!                              dsal_ocn = zfons / (rhop(ji,jj,1) * mld) 
     1198! 
     1199!           ! put increments in for levels in the mixed layer 
     1200!           ! but prevent salinity below a threshold value  
     1201! 
     1202!                   DO jk = 1, jkmax               
     1203! 
     1204!                     IF (dsal_ocn > 0.0_wp .or. sb(ji,jj,jk)+dsal_ocn > sal_thresh) THEN  
     1205!                           sb(ji,jj,jk) = sb(ji,jj,jk) + dsal_ocn 
     1206!                           sn(ji,jj,jk) = sn(ji,jj,jk) + dsal_ocn 
     1207!                     ENDIF 
     1208! 
     1209!                   ENDDO 
     1210! 
     1211!      !            !  salt exchanges at the ice/ocean interface 
     1212!      !            zpmess         = zfons / rdt_ice    ! rdt_ice is ice timestep 
     1213!      ! 
     1214!      !! Adjust fsalt. A +ve fsalt means adding salt to ocean 
     1215!      !!           fsalt(ji,jj) =  fsalt(ji,jj) + zpmess     ! adjust fsalt   
     1216!      !!                
     1217!      !!           emps(ji,jj) = emps(ji,jj) + zpmess        ! or adjust emps (see icestp1d)  
     1218!      !!                                                     ! E-P (kg m-2 s-2) 
     1219!      !            emp(ji,jj) = emp(ji,jj) + zpmess          ! E-P (kg m-2 s-2) 
     1220!               ENDDO !ji 
     1221!             ENDDO !jj! 
     1222! 
     1223!            ENDIF !ln_seaicebal 
     1224! 
     1225!#endif 
     1226 
     1227 
     1228   END SUBROUTINE sit_asm_inc 
    9901229 
    9911230   SUBROUTINE seaice_asm_inc( kt, kindic ) 
     
    9931232      !!                    ***  ROUTINE seaice_asm_inc  *** 
    9941233      !!           
    995       !! ** Purpose : Apply the sea ice assimilation increment. 
     1234      !! ** Purpose : Apply the sea ice concentration assimilation increment. 
    9961235      !! 
    9971236      !! ** Method  : Direct initialization or Incremental Analysis Updating. 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r10302 r11939  
    105105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice           !: sea-ice surface skin temperature (on categories) 
    106106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   kn_ice             !: sea-ice surface layer thermal conductivity (on cats) 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   thick_iu           !: ice thickness at NEMO U point 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   thick_iv           !: ice thickness at NEMO V point 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   thick_su           !: snow depth at NEMO U point 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   thick_sv           !: snow depth at NEMO V point 
    107111 
    108112   ! variables used in the coupled interface 
     
    116120#if defined key_asminc 
    117121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ndaice_da          !: NEMO fresh water flux to ocean due to data assim 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ndsit_da           !: NEMO ice thickness change due to data assim 
    118123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfresh_da          !: NEMO salt flux to ocean due to data assim 
    119124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nfsalt_da          !: NEMO ice concentration change/second from data assim 
     
    171176                wndj_ice(jpi,jpj)     , nfrzmlt(jpi,jpj)      , ss_iou(jpi,jpj)       , & 
    172177                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
     178                thick_iu(jpi,jpj)     , thick_iv(jpi,jpj)     ,                         & 
     179                thick_su(jpi,jpj)     , thick_sv(jpi,jpj)     ,                         & 
     180                ht_i(jpi,jpj,ncat)    , ht_s(jpi,jpj,ncat)    ,                         & 
    173181                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    174182#if defined key_asminc 
    175183                ndaice_da(jpi,jpj)    , nfresh_da(jpi,jpj)    , nfsalt_da(jpi,jpj)    , & 
     184                ndsit_da(jpi,jpj)     ,                                                 & 
    176185#endif 
    177186                sstfrz(jpi,jpj)       , STAT= ierr(1) ) 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r8046 r11939  
    121121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    122122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thick_i           !: ice thickness [m] 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thick_s           !: snow depth [m] 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vol_i             !: ice volume [m3] 
    123126#if defined key_cpl_carbon_cycle 
    124127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
     
    196199         ! 
    197200      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 
     201         & thick_i(jpi,jpj) , thick_s(jpi,jpj) , vol_i(jpi,jpj) ,         &   
    198202#if defined key_cpl_carbon_cycle 
    199203         &      atm_co2(jpi,jpj) ,                                        & 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_sit/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r10302 r11939  
    5757                flatn_f,fsurfn_f,fcondtopn_f,                    & 
    5858#ifdef key_asminc 
    59                 daice_da,fresh_da,fsalt_da,                    & 
     59                daice_da,dhi_da,fresh_da,fsalt_da,               & 
    6060#endif 
    6161                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
     
    250250      CALL lbc_lnk ( fr_iu , 'U', 1. ) 
    251251      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
     252 
     253! Snow and ice thickness 
     254! vice, vsno is volume per unit area of grid cell = thickness 
     255      CALL cice2nemo(vice,thick_i,'T', 1. ) 
     256      CALL cice2nemo(vsno,thick_s,'T', 1. ) 
     257      
     258      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
     259         DO jl = 1,ncat 
     260            CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 
     261            CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
     262         ENDDO 
     263      ENDIF 
     264 
     265! T point to U point 
     266! T point to V point 
     267 
     268! Sea ice thickness 
     269      thick_iu(:,:)=0.0 
     270      thick_iv(:,:)=0.0 
     271      DO jj=1,jpjm1 
     272         DO ji=1,jpim1 
     273            thick_iu(ji,jj)=0.5*(thick_i(ji,jj)+thick_i(ji+1,jj))*umask(ji,jj,1) 
     274            thick_iv(ji,jj)=0.5*(thick_i(ji,jj)+thick_i(ji,jj+1))*vmask(ji,jj,1) 
     275         ENDDO 
     276      ENDDO 
     277 
     278      CALL lbc_lnk ( thick_iu , 'U', 1. ) 
     279      CALL lbc_lnk ( thick_iv , 'V', 1. ) 
     280 
     281! Snow depth 
     282      thick_su(:,:)=0.0 
     283      thick_sv(:,:)=0.0 
     284      DO jj=1,jpjm1 
     285         DO ji=1,jpim1 
     286            thick_su(ji,jj)=0.5*(thick_s(ji,jj)+thick_s(ji+1,jj))*umask(ji,jj,1) 
     287            thick_sv(ji,jj)=0.5*(thick_s(ji,jj)+thick_s(ji,jj+1))*vmask(ji,jj,1) 
     288         ENDDO 
     289      ENDDO 
     290 
     291      CALL lbc_lnk ( thick_su , 'U', 1. ) 
     292      CALL lbc_lnk ( thick_sv , 'V', 1. )      
    252293 
    253294      !                                      ! embedded sea ice 
     
    311352      nfsalt_da(:,:) = 0.0    
    312353      ndaice_da(:,:) = 0.0          
     354      ndsit_da(:,:)  = 0.0          
    313355#endif 
    314356      ! 
     
    469511      ztmp(:,:)=ndaice_da(:,:)*tmask(:,:,1) 
    470512      Call nemo2cice(ztmp,daice_da,'T', 1. ) 
     513!Ice thickness change (from assimilation) 
     514      ztmp(:,:)=ndsit_da(:,:)*tmask(:,:,1) 
     515      Call nemo2cice(ztmp,dhi_da,'T', 1. ) 
    471516#endif  
    472517 
Note: See TracChangeset for help on using the changeset viewer.