Changeset 5779


Ignore:
Timestamp:
2015-10-06T18:28:13+02:00 (5 years ago)
Author:
mathiot
Message:

ISF coupling branch: correct some compilation issues, remove code related to MISOMIP/ISOMIP+ and polishing

Location:
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO
Files:
20 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r5504 r5779  
    122122         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
    123123         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    124          &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
     124         &             nn_write, ln_iscpl, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
    125125      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   & 
    126126         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            & 
     
    839839      DO jj = 1, jpjm1 
    840840         DO ji = 1, fs_jpim1   ! vector loop 
    841             umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    842             vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     841            ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     842            ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    843843         END DO 
    844844         DO ji = 1, jpim1      ! NO vector opt. 
    845             fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     845            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    846846               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    847847         END DO 
    848848      END DO 
    849       CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
    850       CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
    851       CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     849      CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
     850      CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
     851      CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    852852 
    853853      ! 3. Ocean/land mask at wu-, wv- and w points  
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r5506 r5779  
    460460      ENDIF 
    461461 
    462       IF( nn_timing == 1 )   CALL timing_start('dia_fwb') 
     462      IF( nn_timing == 1 )   CALL timing_stop('dia_fwb') 
    463463 
    464464 9005 FORMAT(1X,A,ES24.16) 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r5619 r5779  
    201201!!gm end 
    202202       
    203       IF (lwp) PRINT *, 'ISCPL CONS HEAT ', kt, zdiff_hc / zvol_tot, zdiff_sc / zvol_tot 
    204       IF (lwp) PRINT *, 'ISCPL CONS VOL  ', kt, zdiff_v1 * 1.e-9, zdiff_v2 * 1.e-9 
    205  
    206203      IF( lk_vvl ) THEN 
    207204        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
     
    218215        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu) 
    219216        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J)  
    220         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content variation (psu*km3) 
    221         CALL iom_put( 'bgvolssh' , (zdiff_v1+zdiff_v2) * 1.e-9    )   ! volume ssh variation (km3)   
     217        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9   )              ! Salt content variation (psu*km3) 
     218        CALL iom_put( 'bgvolssh' , zdiff_v1  * 1.e-9   )              ! volume ssh variation (km3)   
    222219        CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    223220        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
     
    279276          ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
    280277          DO jk = 1, jpk 
     278             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
    281279             e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)    * tmask(:,:,jk)                    ! initial vertical scale factors 
    282280             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r5619 r5779  
    115115 
    116116                             CALL dom_stp      ! time step 
    117       IF( nmsh /= 0 .AND. .NOT. ln_iscpl )   CALL dom_wri      ! Create a domain file 
     117      ! 
     118      IF( nmsh /= 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file 
     119      IF( nmsh /= 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file 
     120      ! 
    118121      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control 
    119122      ! 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r5619 r5779  
    4040      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point 
    4141      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point 
    42       INTEGER         , INTENT(in   ), OPTIONAL :: kkk 
     42      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used 
    4343      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W' 
    4444      ! 
     
    7272         zglam(:,:) = zglam(:,:) - plon 
    7373      END IF 
    74 ! 
     74 
    7575      zgphi(:,:) = zgphi(:,:) - plat 
    7676      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:) 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r5619 r5779  
    2828   USE in_out_manager  ! I/O manager 
    2929   USE iom             ! I/O manager library 
    30    USE restart  , ONLY : rst_read_open    ! ocean restart 
     30   USE restart, ONLY : rst_read_open    ! ocean restart 
    3131   USE lib_mpp         ! distributed memory computing library 
    3232   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r5619 r5779  
    472472         risfdep(:,:)=0.e0 
    473473         misfdep(:,:)=1 
    474          ! 
    475          ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code 
    476          IF( cp_cfg == "isomip" .AND. ln_isfcav ) THEN  
    477             risfdep(:,:)=200.e0  
    478             misfdep(:,:)=1  
    479             ij0 = 1 ; ij1 = 40  
    480             DO jj = mj0(ij0), mj1(ij1)  
    481                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp  
    482             END DO  
    483             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp  
    484          !  
    485          ELSEIF ( cp_cfg == "isomip2" .AND. ln_isfcav ) THEN 
    486          !  
    487             risfdep(:,:)=0.e0 
    488             misfdep(:,:)=1 
    489             ij0 = 1 ; ij1 = 40 
    490             DO jj = mj0(ij0), mj1(ij1) 
    491                risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    492             END DO 
    493             WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
    494          END IF 
    495474         ! 
    496475         DEALLOCATE( idta, zdta ) 
     
    549528               CALL iom_close( inum ) 
    550529               WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
     530 
     531               ! set grounded point to 0 (treshold at 1cm, have to be update after first coupling experience) 
     532               WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 
     533                  misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
     534                  mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
     535               END WHERE 
    551536            END IF 
    552             ! set grounded point to 0 
    553             WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 
    554                misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    555                mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
    556             END WHERE 
    557537            !        
    558538            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     
    12601240      END WHERE   
    12611241 
    1262       ! set grounded point to 0 
    1263       WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 
    1264          misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    1265          mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
    1266       END WHERE 
    1267  
    12681242      ! Compute misfdep for ocean points (i.e. first wet level)  
    12691243      ! find the first ocean level such that the first level thickness  
     
    12781252      END WHERE 
    12791253 
    1280       ! remove very shallow ice shelf (less than ~ 10m if 75L) 
    1281       IF ( cp_cfg .NE. "isomip" ) THEN 
    1282          WHERE (risfdep(:,:) < 100 ) 
    1283             misfdep = 1; risfdep = 0.0_wp; 
    1284          END WHERE 
    1285       END IF 
    1286   
    12871254! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation 
    12881255      icompt = 0  
    12891256! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together 
    12901257      DO jl = 1, 10      
     1258         ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments) 
    12911259         WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 
    12921260            misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r5619 r5779  
    3434 
    3535   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read) 
    36    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsddmp   ! structure of input SST (file informations, fields read) 
    3736 
    3837   !! * Substitutions 
     
    6160      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read 
    6261      TYPE(FLD_N)                   ::   sn_tem, sn_sal 
    63       TYPE(FLD_N)                   ::   sn_dmpt, sn_dmps 
    6462      !! 
    6563      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 
    66       NAMELIST/namtra_dmpfile/ sn_dmpt, sn_dmps 
    6764      INTEGER  ::   ios 
    6865      !!---------------------------------------------------------------------- 
     
    8178902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp ) 
    8279      IF(lwm) WRITE ( numond, namtsd ) 
    83  
    84       REWIND( numnam_ref )              ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term 
    85       READ  ( numnam_ref, namtra_dmpfile, IOSTAT = ios, ERR = 903) 
    86 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp ) 
    87  
    88       REWIND( numnam_cfg )              ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term 
    89       READ  ( numnam_cfg, namtra_dmpfile, IOSTAT = ios, ERR = 904 ) 
    90 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 
    9180 
    9281      IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used 
     
    116105         ! 
    117106         ALLOCATE( sf_tsd(jpts), STAT=ierr0 ) 
    118          ALLOCATE( sf_tsddmp(jpts), STAT=ierr0 ) 
    119107         IF( ierr0 > 0 ) THEN 
    120108            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN 
     
    125113                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    126114         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    127          ! dmp file 
    128                                  ALLOCATE( sf_tsddmp(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 ) 
    129          IF( sn_dmpt%ln_tint )   ALLOCATE( sf_tsddmp(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 
    130                                  ALLOCATE( sf_tsddmp(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    131          IF( sn_dmps%ln_tint )   ALLOCATE( sf_tsddmp(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    132115         ! 
    133116         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN 
     
    137120         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal 
    138121         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' ) 
    139          slf_i(jp_tem) = sn_dmpt   ;   slf_i(jp_sal) = sn_dmps 
    140          CALL fld_fill( sf_tsddmp, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' ) 
    141122         ! 
    142123      ENDIF 
     
    147128 
    148129 
    149    SUBROUTINE dta_tsd( kt, ptsd, ptsddmp ) 
     130   SUBROUTINE dta_tsd( kt, ptsd ) 
    150131      !!---------------------------------------------------------------------- 
    151132      !!                   ***  ROUTINE dta_tsd  *** 
     
    164145      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step 
    165146      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    166       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), OPTIONAL, INTENT(  out) ::   ptsddmp   ! T & S data 
    167147      ! 
    168148      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
     
    175155      ! 
    176156      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
    177       IF ( PRESENT(ptsddmp) ) THEN 
    178          CALL fld_read( kt, 1, sf_tsddmp )      !==   read T & S data at kt time step   ==! 
    179          ptsddmp(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:)    ! NO mask 
    180          ptsddmp(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:)  
    181       END IF 
    182157      ! 
    183158      ! 
     
    329304         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta ) 
    330305                                        DEALLOCATE( sf_tsd              )     ! the structure itself 
    331          IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run' 
    332                                         DEALLOCATE( sf_tsddmp(jp_tem)%fnow )     ! T arrays in the structure 
    333          IF( sf_tsddmp(jp_tem)%ln_tint )   DEALLOCATE( sf_tsddmp(jp_tem)%fdta ) 
    334                                         DEALLOCATE( sf_tsddmp(jp_sal)%fnow )     ! S arrays in the structure 
    335          IF( sf_tsddmp(jp_sal)%ln_tint )   DEALLOCATE( sf_tsddmp(jp_sal)%fdta ) 
    336                                         DEALLOCATE( sf_tsddmp              )     ! the structure itself 
    337306      ENDIF 
    338307      ! 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r5619 r5779  
    4747   USE wrk_nemo        ! Memory allocation 
    4848   USE timing          ! Timing 
    49    USE sbc_iscpl 
     49   USE iscplrst 
    5050 
    5151   IMPLICIT NONE 
     
    9191      IF( ln_rstart ) THEN                    ! Restart from a file 
    9292         !                                    ! ------------------- 
    93          CALL rst_read                           ! Read the restart file 
    94          IF (ln_iscpl) CALL rst_iscpl            ! extraloate restart to wet and dry 
    95          CALL day_init                           ! model calendar (using both namelist and restart infos) 
     93         CALL rst_read                        ! Read the restart file 
     94         IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry 
     95         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    9696      ELSE 
    9797         !                                    ! Start from rest 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5619 r5779  
    7373   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
    7474#else 
    75    REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
     75   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3] 
    7676   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K] 
    7777   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K] 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5619 r5779  
    2929   USE sbcrnf          ! river runoff  
    3030   USE sbcisf          ! ice shelf  
    31    USE sbc_iscpl        ! ice shelf  
     31   USE iscplhsb       ! ice sheet / ocean coupling 
     32   USE iscplini        ! 
    3233   USE cla             ! cross land advection             (cla_div routine) 
    3334   USE in_out_manager  ! I/O manager 
     
    330331      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )                            ! runoffs (update hdivn field) 
    331332      IF( ln_divisf .AND. (nn_isf .GT. 0) )   CALL sbc_isf_div  ( hdivn )      ! ice shelf (update hdivn field) 
    332       IF( ln_iscpl  .AND. ln_hfb )            CALL sbc_iscpl_div( hdivn )      ! ice shelf (update hdivn field) 
     333      IF( ln_iscpl  .AND. ln_hsb )            CALL iscpl_div( hdivn )      ! ice shelf (update hdivn field) 
    333334      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    334335      ! 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r5619 r5779  
    2424   USE trdmxl_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    26    USE wrk_nemo 
    2726 
    2827   IMPLICIT NONE 
     
    147146#endif 
    148147 
    149  
    150  
    151148                  IF ( ln_iscpl ) THEN  
    152149                     CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask     ) ! need to extrapolate T/S 
     
    154151                     CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask     ) ! need to correct barotropic velocity 
    155152                     CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask    ) ! need to correct barotropic velocity 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) ) ! need to compute temperature correction 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'fse3u_n', fse3u_n(:,:,:) ) ! need to compute volume      correction  ???? 
    158                      CALL iom_rstput( kt, nitrst, numrow, 'fse3v_n', fse3v_n(:,:,:) ) ! need to compute volume      correction  ???? 
    159                      CALL iom_rstput( kt, nitrst, numrow, 'fsdepw_n', fsdepw_n(:,:,:) ) ! need to compute volume      correction  ???? 
     153                     CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) )   ! need to compute temperature correction 
     154                     CALL iom_rstput( kt, nitrst, numrow, 'fse3u_n', fse3u_n(:,:,:) )   ! need to compute bt conservation 
     155                     CALL iom_rstput( kt, nitrst, numrow, 'fse3v_n', fse3v_n(:,:,:) )   ! need to compute bt conservation 
     156                     CALL iom_rstput( kt, nitrst, numrow, 'fsdepw_n', fsdepw_n(:,:,:) ) ! need to compute extrapolation if vvl 
    160157                  END IF 
    161158      IF( kt == nitrst ) THEN 
     
    221218      REAL(wp) ::   zrdt, zrdttra1 
    222219      INTEGER  ::   jk 
    223       LOGICAL  ::   llok 
    224220      !!---------------------------------------------------------------------- 
    225221 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5619 r5779  
    3232 
    3333   INTERFACE lbc_sum 
    34       MODULE PROCEDURE mpp_sum_3d, mpp_sum_2d 
     34      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    3535   END INTERFACE 
    3636 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r5619 r5779  
    7272   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    7373   PUBLIC   mpp_lnk_2d_9  
    74    PUBLIC   mpp_sum_3d, mpp_sum_2d 
     74   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    7575   PUBLIC   mppscatter, mppgather 
    7676   PUBLIC   mpp_ini_ice, mpp_ini_znl 
     
    13951395   END SUBROUTINE mpp_lnk_2d_e 
    13961396 
    1397    SUBROUTINE mpp_sum_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    1398       !!---------------------------------------------------------------------- 
    1399       !!                  ***  routine mpp_sum_3d  *** 
    1400       !! 
    1401       !! ** Purpose :   Message passing manadgement 
     1397   SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
     1398      !!---------------------------------------------------------------------- 
     1399      !!                  ***  routine mpp_lnk_sum_3d  *** 
     1400      !! 
     1401      !! ** Purpose :   Message passing manadgement (sum in the overlap region) 
    14021402      !! 
    14031403      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     
    14451445      ! 1. standard boundary treatment 
    14461446      ! ------------------------------ 
    1447       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    1448          ! 
    1449          ! WARNING ptab is defined only between nld and nle 
    1450 !         DO jk = 1, jpk 
    1451 !            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    1452 !               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
    1453 !               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    1454 !               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
    1455 !            END DO 
    1456 !            DO ji = nlci+1, jpi                 ! added column(s) (full) 
    1457 !               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
    1458 !               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
    1459 !               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
    1460 !            END DO 
    1461 !         END DO 
    1462          ! 
    1463       ELSE                              ! standard close or cyclic treatment 
    1464          ! 
    1465          !                                   ! East-West boundaries 
    1466          !                                        !* Cyclic east-west 
    1467          IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1468 !            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    1469 !            ptab(jpi,:,:) = ptab(  2  ,:,:) 
    1470          ELSE                                     !* closed 
    1471 !            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    1472 !                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    1473          ENDIF 
    1474          !                                   ! North-South boundaries (always closed) 
    1475 !         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    1476 !                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    1477          ! 
    1478       ENDIF 
    1479  
    14801447      ! 2. East and west directions exchange 
    14811448      ! ------------------------------------ 
    14821449      ! we play with the neigbours AND the row number because of the periodicity 
    14831450      ! 
    1484       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     1451      SELECT CASE ( nbondi )      ! Read lateral conditions 
    14851452      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    14861453      iihom = nlci-jpreci 
     
    15121479      END SELECT 
    15131480      ! 
    1514       !                           ! Write Dirichlet lateral conditions 
     1481      !                           ! Write lateral conditions 
    15151482      iihom = nlci-nreci 
    15161483      ! 
     
    15361503      ! always closed : we play only with the neigbours 
    15371504      ! 
    1538       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     1505      IF( nbondj /= 2 ) THEN      ! Read lateral conditions 
    15391506         ijhom = nlcj-jprecj 
    15401507         DO jl = 1, jprecj 
     
    15651532      END SELECT 
    15661533      ! 
    1567       !                           ! Write Dirichlet lateral conditions 
     1534      !                           ! Write lateral conditions 
    15681535      ijhom = nlcj-nrecj 
    15691536      ! 
     
    15991566      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    16001567      ! 
    1601    END SUBROUTINE mpp_sum_3d 
    1602  
    1603    SUBROUTINE mpp_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    1604       !!---------------------------------------------------------------------- 
    1605       !!                  ***  routine mpp_sum_2d  *** 
    1606       !! 
    1607       !! ** Purpose :   Message passing manadgement for 2d array 
     1568   END SUBROUTINE mpp_lnk_sum_3d 
     1569 
     1570   SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     1571      !!---------------------------------------------------------------------- 
     1572      !!                  ***  routine mpp_lnk_sum_2d  *** 
     1573      !! 
     1574      !! ** Purpose :   Message passing manadgement for 2d array (sum in the overlap region) 
    16081575      !! 
    16091576      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     
    16491616      ! 1. standard boundary treatment 
    16501617      ! ------------------------------ 
    1651       ! 
    1652 !      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    1653 !         ! 
    1654 !         ! WARNING pt2d is defined only between nld and nle 
    1655 !         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    1656 !            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
    1657 !            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    1658 !            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
    1659 !         END DO 
    1660 !         DO ji = nlci+1, jpi                 ! added column(s) (full) 
    1661 !            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
    1662 !            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
    1663 !            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
    1664 !         END DO 
    1665 !         ! 
    1666 !      ELSE                              ! standard close or cyclic treatment 
    1667 !         ! 
    1668 !         !                                   ! East-West boundaries 
    1669 !         IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
    1670 !            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1671 !            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
    1672 !            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
    1673 !         ELSE                                     ! closed 
    1674 !            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    1675 !                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    1676 !         ENDIF 
    1677 !         !                                   ! North-South boundaries (always closed) 
    1678 !            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
    1679 !                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    1680 !         ! 
    1681 !      ENDIF 
    1682  
    16831618      ! 2. East and west directions exchange 
    16841619      ! ------------------------------------ 
    16851620      ! we play with the neigbours AND the row number because of the periodicity 
    16861621      ! 
    1687       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     1622      SELECT CASE ( nbondi )      ! Read lateral conditions 
    16881623      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    16891624         iihom = nlci - jpreci 
     
    17151650      END SELECT 
    17161651      ! 
    1717       !                           ! Write Dirichlet lateral conditions 
     1652      !                           ! Write lateral conditions 
    17181653      iihom = nlci-nreci 
    17191654      ! 
     
    17391674      ! always closed : we play only with the neigbours 
    17401675      ! 
    1741       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     1676      IF( nbondj /= 2 ) THEN      ! Read lateral conditions 
    17421677         ijhom = nlcj - jprecj 
    17431678         DO jl = 1, jprecj 
     
    17681703      END SELECT 
    17691704      ! 
    1770       !                           ! Write Dirichlet lateral conditions 
     1705      !                           ! Write lateral conditions 
    17711706      ijhom = nlcj-nrecj 
    17721707      ! 
     
    18021737      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    18031738      ! 
    1804    END SUBROUTINE mpp_sum_2d 
     1739   END SUBROUTINE mpp_lnk_sum_2d 
    18051740 
    18061741   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req ) 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r5619 r5779  
    111111            zcoef = z_fwf * rcp 
    112112            emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1) 
    113             sfx(:,:) = sfx(:,:) + z_fwf * sss_m      * tmask(:,:,1) 
    114113            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 
    115114         ENDIF 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r5619 r5779  
    6363 
    6464   REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ? 
    65    REAL(wp), PUBLIC, SAVE ::   kappa  =    0.0_wp    ! phycst ? 
     65   REAL(wp), PUBLIC, SAVE ::   kappa  = 1.54e-6_wp    ! phycst ? 
    6666   REAL(wp), PUBLIC, SAVE ::   rhoisf = 920.0_wp      ! phycst ? 
    6767   REAL(wp), PUBLIC, SAVE ::   tsurf  = -20.0_wp      ! phycst ? 
     
    152152            !: read effective lenght (BG03) 
    153153            IF (nn_isf == 2) THEN 
    154                cvarLeff = 'soLeff'  
     154               ! Read Data and save some integral values 
    155155               CALL iom_open( sn_Leff_isf%clname, inum ) 
     156               cvarLeff  = 'soLeff'               !: variable name for Efficient Length scale 
    156157               CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1) 
    157158               CALL iom_close(inum) 
     
    297298         !  
    298299         ! output 
    299          IF( iom_use('qisf'  ) )   CALL iom_put('qisf'  , qisf) 
    300          IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf) 
     300         CALL iom_put('qisf'  , qisf) 
     301         IF( iom_use('fwfisf') )   CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 
    301302      END IF 
    302303   
     
    528529! zwflx is upward water flux 
    529530! If non conservative we have zcfac=0.0 so what follows is then zfwflx*sss_m/zsfrz 
    530 !!!!!!!!                     zfwflx = ( zgammas*rau0 - zcfac*zfwflx ) * (zsfrz - stbl(ji,jj)) / stbl(ji,jj) 
     531                     zfwflx = ( zgammas*rau0 - zcfac*zfwflx ) * (zsfrz - stbl(ji,jj)) / stbl(ji,jj) 
    531532! test convergence and compute gammat 
    532533                     IF (( zhtflx - zhtflx_b) .LE. 0.01 ) lit = .FALSE. 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r5619 r5779  
    921921               pn2(ji,jj,jk) = grav * (  zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )     & 
    922922                  &                    - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  )  & 
    923                   &            / fse3w(ji,jj,jk) * wmask(ji,jj,jk) 
     923                  &            / fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
    924924            END DO 
    925925         END DO 
     
    12421242      ! 
    12431243      rau0        = 1026._wp                 !: volumic mass of reference     [kg/m3] 
    1244       rcp         = 3974._wp      !: heat capacity     [J/K] 
     1244      rcp         = 3991.86795711963_wp      !: heat capacity     [J/K] 
    12451245      ! 
    12461246      IF(lwp) THEN                ! Control print 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r5619 r5779  
    102102      REAL(wp) ::   zta, zsa             ! local scalars 
    103103      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta  
    104       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dtadmp  
    105104      !!---------------------------------------------------------------------- 
    106105      ! 
    107106      IF( nn_timing == 1 )  CALL timing_start( 'tra_dmp') 
    108107      ! 
    109       CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta, zts_dtadmp ) 
     108      CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta ) 
    110109      !                           !==   input T-S data at kt   ==! 
    111       CALL dta_tsd( kt, zts_dta, zts_dtadmp )            ! read and interpolates T-S data at kt 
    112       zts_dta=zts_dtadmp 
     110      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    113111      ! 
    114112      SELECT CASE ( nn_zdmp )     !==    type of damping   ==! 
     
    176174         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    177175      ! 
    178       CALL wrk_dealloc( jpi, jpj, jpk, jpts,  zts_dta, zts_dtadmp ) 
     176      CALL wrk_dealloc( jpi, jpj, jpk, jpts,  zts_dta ) 
    179177      ! 
    180178      IF( nn_timing == 1 )  CALL timing_stop( 'tra_dmp') 
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r5619 r5779  
    2222   USE sbcrnf          ! River runoff   
    2323   USE sbcisf          ! Ice shelf    
    24    USE sbc_iscpl       ! Ice sheet coupling 
     24   USE iscplini       ! Ice sheet coupling 
    2525   USE traqsr          ! solar radiation penetration 
    2626   USE trd_oce         ! trends: ocean variables 
     
    291291      !---------------------------------------- 
    292292      ! 
    293       IF( ln_iscpl .AND. ln_hfb) THEN         ! input of heat and salt due to river runoff  
     293      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff  
    294294         DO jk = 1,jpk 
    295295            DO jj = 2, jpj  
  • branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r5619 r5779  
    163163   FUNCTION glob_sum_full_2d( ptab ) 
    164164      !!---------------------------------------------------------------------- 
    165       !!                  ***  FUNCTION  glob_sum_2d *** 
    166       !! 
    167       !! ** Purpose : perform a sum in calling DDPDD routine 
     165      !!                  ***  FUNCTION  glob_sum_full_2d *** 
     166      !! 
     167      !! ** Purpose : perform a sum in calling DDPDD routine (nomask) 
    168168      !!---------------------------------------------------------------------- 
    169169      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
    170       REAL(wp)                             ::   glob_sum_full_2d   ! global masked sum 
     170      REAL(wp)                             ::   glob_sum_full_2d   ! global sum 
    171171      !! 
    172172      !!----------------------------------------------------------------------- 
     
    179179   FUNCTION glob_sum_full_3d( ptab ) 
    180180      !!---------------------------------------------------------------------- 
    181       !!                  ***  FUNCTION  glob_sum_3d *** 
    182       !! 
    183       !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 
     181      !!                  ***  FUNCTION  glob_sum_full_3d *** 
     182      !! 
     183      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask) 
    184184      !!---------------------------------------------------------------------- 
    185185      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
    186       REAL(wp)                               ::   glob_sum_full_3d   ! global masked sum 
     186      REAL(wp)                               ::   glob_sum_full_3d   ! global sum 
    187187      !! 
    188188      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     
    192192      ijpk = SIZE(ptab,3) 
    193193      ! 
    194       glob_sum_3d = 0.e0 
     194      glob_sum_full_3d = 0.e0 
    195195      DO jk = 1, ijpk 
    196          glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk) ) 
     196         glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) ) 
    197197      END DO 
    198198      IF( lk_mpp )   CALL mpp_sum( glob_sum_full_3d ) 
Note: See TracChangeset for help on using the changeset viewer.