Changeset 5779
- Timestamp:
- 2015-10-06T18:28:13+02:00 (8 years ago)
- 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 122 122 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 123 123 & 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_euler124 & nn_write, ln_iscpl, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 125 125 NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & 126 126 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & … … 839 839 DO jj = 1, jpjm1 840 840 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,:))) 843 843 END DO 844 844 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 ) & 846 846 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 847 847 END DO 848 848 END DO 849 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions850 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 ) 852 852 853 853 ! 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 460 460 ENDIF 461 461 462 IF( nn_timing == 1 ) CALL timing_st art('dia_fwb')462 IF( nn_timing == 1 ) CALL timing_stop('dia_fwb') 463 463 464 464 9005 FORMAT(1X,A,ES24.16) -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5619 r5779 201 201 !!gm end 202 202 203 IF (lwp) PRINT *, 'ISCPL CONS HEAT ', kt, zdiff_hc / zvol_tot, zdiff_sc / zvol_tot204 IF (lwp) PRINT *, 'ISCPL CONS VOL ', kt, zdiff_v1 * 1.e-9, zdiff_v2 * 1.e-9205 206 203 IF( lk_vvl ) THEN 207 204 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) … … 218 215 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 219 216 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) 222 219 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 223 220 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) … … 279 276 ssh_ini(:,:) = sshn(:,:) ! initial ssh 280 277 DO jk = 1, jpk 278 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 281 279 e3t_ini (:,:,jk) = fse3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 282 280 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 115 115 116 116 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 ! 118 121 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 119 122 ! -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r5619 r5779 40 40 REAL(wp) , INTENT(in ) :: plon, plat ! longitude,latitude of the point 41 41 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 43 43 CHARACTER(len=1), INTENT(in ) :: cdgrid ! grid name 'T', 'U', 'V', 'W' 44 44 ! … … 72 72 zglam(:,:) = zglam(:,:) - plon 73 73 END IF 74 ! 74 75 75 zgphi(:,:) = zgphi(:,:) - plat 76 76 zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:) -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5619 r5779 28 28 USE in_out_manager ! I/O manager 29 29 USE iom ! I/O manager library 30 USE restart 30 USE restart, ONLY : rst_read_open ! ocean restart 31 31 USE lib_mpp ! distributed memory computing library 32 32 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 472 472 risfdep(:,:)=0.e0 473 473 misfdep(:,:)=1 474 !475 ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code476 IF( cp_cfg == "isomip" .AND. ln_isfcav ) THEN477 risfdep(:,:)=200.e0478 misfdep(:,:)=1479 ij0 = 1 ; ij1 = 40480 DO jj = mj0(ij0), mj1(ij1)481 risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp482 END DO483 WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp484 !485 ELSEIF ( cp_cfg == "isomip2" .AND. ln_isfcav ) THEN486 !487 risfdep(:,:)=0.e0488 misfdep(:,:)=1489 ij0 = 1 ; ij1 = 40490 DO jj = mj0(ij0), mj1(ij1)491 risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp492 END DO493 WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp494 END IF495 474 ! 496 475 DEALLOCATE( idta, zdta ) … … 549 528 CALL iom_close( inum ) 550 529 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 551 536 END IF 552 ! set grounded point to 0553 WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 )554 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp555 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp556 END WHERE557 537 ! 558 538 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration … … 1260 1240 END WHERE 1261 1241 1262 ! set grounded point to 01263 WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 )1264 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp1265 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp1266 END WHERE1267 1268 1242 ! Compute misfdep for ocean points (i.e. first wet level) 1269 1243 ! find the first ocean level such that the first level thickness … … 1278 1252 END WHERE 1279 1253 1280 ! remove very shallow ice shelf (less than ~ 10m if 75L)1281 IF ( cp_cfg .NE. "isomip" ) THEN1282 WHERE (risfdep(:,:) < 100 )1283 misfdep = 1; risfdep = 0.0_wp;1284 END WHERE1285 END IF1286 1287 1254 ! 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 1288 1255 icompt = 0 1289 1256 ! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together 1290 1257 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) 1291 1259 WHERE (bathy(:,:) .LE. risfdep(:,:)+1e-2 ) 1292 1260 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r5619 r5779 34 34 35 35 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)37 36 38 37 !! * Substitutions … … 61 60 TYPE(FLD_N), DIMENSION( jpts) :: slf_i ! array of namelist informations on the fields to read 62 61 TYPE(FLD_N) :: sn_tem, sn_sal 63 TYPE(FLD_N) :: sn_dmpt, sn_dmps64 62 !! 65 63 NAMELIST/namtsd/ ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 66 NAMELIST/namtra_dmpfile/ sn_dmpt, sn_dmps67 64 INTEGER :: ios 68 65 !!---------------------------------------------------------------------- … … 81 78 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp ) 82 79 IF(lwm) WRITE ( numond, namtsd ) 83 84 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term85 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 term89 READ ( numnam_cfg, namtra_dmpfile, IOSTAT = ios, ERR = 904 )90 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )91 80 92 81 IF( PRESENT( ld_tradmp ) ) ln_tsd_tradmp = .TRUE. ! forces the initialization when tradmp is used … … 116 105 ! 117 106 ALLOCATE( sf_tsd(jpts), STAT=ierr0 ) 118 ALLOCATE( sf_tsddmp(jpts), STAT=ierr0 )119 107 IF( ierr0 > 0 ) THEN 120 108 CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' ) ; RETURN … … 125 113 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 126 114 IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 127 ! dmp file128 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 )132 115 ! 133 116 IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN … … 137 120 slf_i(jp_tem) = sn_tem ; slf_i(jp_sal) = sn_sal 138 121 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_dmps140 CALL fld_fill( sf_tsddmp, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )141 122 ! 142 123 ENDIF … … 147 128 148 129 149 SUBROUTINE dta_tsd( kt, ptsd , ptsddmp)130 SUBROUTINE dta_tsd( kt, ptsd ) 150 131 !!---------------------------------------------------------------------- 151 132 !! *** ROUTINE dta_tsd *** … … 164 145 INTEGER , INTENT(in ) :: kt ! ocean time-step 165 146 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 data167 147 ! 168 148 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies … … 175 155 ! 176 156 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 177 IF ( PRESENT(ptsddmp) ) THEN178 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 mask180 ptsddmp(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:)181 END IF182 157 ! 183 158 ! … … 329 304 IF( sf_tsd(jp_sal)%ln_tint ) DEALLOCATE( sf_tsd(jp_sal)%fdta ) 330 305 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 structure333 IF( sf_tsddmp(jp_tem)%ln_tint ) DEALLOCATE( sf_tsddmp(jp_tem)%fdta )334 DEALLOCATE( sf_tsddmp(jp_sal)%fnow ) ! S arrays in the structure335 IF( sf_tsddmp(jp_sal)%ln_tint ) DEALLOCATE( sf_tsddmp(jp_sal)%fdta )336 DEALLOCATE( sf_tsddmp ) ! the structure itself337 306 ENDIF 338 307 ! -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5619 r5779 47 47 USE wrk_nemo ! Memory allocation 48 48 USE timing ! Timing 49 USE sbc_iscpl49 USE iscplrst 50 50 51 51 IMPLICIT NONE … … 91 91 IF( ln_rstart ) THEN ! Restart from a file 92 92 ! ! ------------------- 93 CALL rst_read 94 IF (ln_iscpl) CALL rst_iscpl! extraloate restart to wet and dry95 CALL day_init 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) 96 96 ELSE 97 97 ! ! Start from rest -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r5619 r5779 73 73 REAL(wp), PUBLIC :: xlsn !: = lfus*rhosn (volumetric latent heat fusion of snow) [J/m3] 74 74 #else 75 REAL(wp), PUBLIC :: rhoic = 9 17._wp !: volumic mass of sea ice [kg/m3]75 REAL(wp), PUBLIC :: rhoic = 900._wp !: volumic mass of sea ice [kg/m3] 76 76 REAL(wp), PUBLIC :: rcdic = 2.034396_wp !: conductivity of the ice [W/m/K] 77 77 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 29 29 USE sbcrnf ! river runoff 30 30 USE sbcisf ! ice shelf 31 USE sbc_iscpl ! ice shelf 31 USE iscplhsb ! ice sheet / ocean coupling 32 USE iscplini ! 32 33 USE cla ! cross land advection (cla_div routine) 33 34 USE in_out_manager ! I/O manager … … 330 331 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field) 331 332 IF( ln_divisf .AND. (nn_isf .GT. 0) ) CALL sbc_isf_div ( hdivn ) ! ice shelf (update hdivn field) 332 IF( ln_iscpl .AND. ln_h fb ) 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) 333 334 IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field) 334 335 ! -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5619 r5779 24 24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 USE wrk_nemo27 26 28 27 IMPLICIT NONE … … 147 146 #endif 148 147 149 150 151 148 IF ( ln_iscpl ) THEN 152 149 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask ) ! need to extrapolate T/S … … 154 151 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask ) ! need to correct barotropic velocity 155 152 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 correction157 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 160 157 END IF 161 158 IF( kt == nitrst ) THEN … … 221 218 REAL(wp) :: zrdt, zrdttra1 222 219 INTEGER :: jk 223 LOGICAL :: llok224 220 !!---------------------------------------------------------------------- 225 221 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r5619 r5779 32 32 33 33 INTERFACE lbc_sum 34 MODULE PROCEDURE mpp_ sum_3d, mpp_sum_2d34 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 35 35 END INTERFACE 36 36 -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r5619 r5779 72 72 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 73 73 PUBLIC mpp_lnk_2d_9 74 PUBLIC mpp_ sum_3d, mpp_sum_2d74 PUBLIC mpp_lnk_sum_3d, mpp_lnk_sum_2d 75 75 PUBLIC mppscatter, mppgather 76 76 PUBLIC mpp_ini_ice, mpp_ini_znl … … 1395 1395 END SUBROUTINE mpp_lnk_2d_e 1396 1396 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) 1402 1402 !! 1403 1403 !! ** Method : Use mppsend and mpprecv function for passing mask … … 1445 1445 ! 1. standard boundary treatment 1446 1446 ! ------------------------------ 1447 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values1448 !1449 ! WARNING ptab is defined only between nld and nle1450 ! DO jk = 1, jpk1451 ! 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 DO1456 ! 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 DO1461 ! END DO1462 !1463 ELSE ! standard close or cyclic treatment1464 !1465 ! ! East-West boundaries1466 ! !* Cyclic east-west1467 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN1468 ! ptab( 1 ,:,:) = ptab(jpim1,:,:)1469 ! ptab(jpi,:,:) = ptab( 2 ,:,:)1470 ELSE !* closed1471 ! IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point1472 ! ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north1473 ENDIF1474 ! ! North-South boundaries (always closed)1475 ! IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point1476 ! ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north1477 !1478 ENDIF1479 1480 1447 ! 2. East and west directions exchange 1481 1448 ! ------------------------------------ 1482 1449 ! we play with the neigbours AND the row number because of the periodicity 1483 1450 ! 1484 SELECT CASE ( nbondi ) ! Read Dirichletlateral conditions1451 SELECT CASE ( nbondi ) ! Read lateral conditions 1485 1452 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 1486 1453 iihom = nlci-jpreci … … 1512 1479 END SELECT 1513 1480 ! 1514 ! ! Write Dirichletlateral conditions1481 ! ! Write lateral conditions 1515 1482 iihom = nlci-nreci 1516 1483 ! … … 1536 1503 ! always closed : we play only with the neigbours 1537 1504 ! 1538 IF( nbondj /= 2 ) THEN ! Read Dirichletlateral conditions1505 IF( nbondj /= 2 ) THEN ! Read lateral conditions 1539 1506 ijhom = nlcj-jprecj 1540 1507 DO jl = 1, jprecj … … 1565 1532 END SELECT 1566 1533 ! 1567 ! ! Write Dirichletlateral conditions1534 ! ! Write lateral conditions 1568 1535 ijhom = nlcj-nrecj 1569 1536 ! … … 1599 1566 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 1600 1567 ! 1601 END SUBROUTINE mpp_ sum_3d1602 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) 1608 1575 !! 1609 1576 !! ** Method : Use mppsend and mpprecv function for passing mask … … 1649 1616 ! 1. standard boundary treatment 1650 1617 ! ------------------------------ 1651 !1652 ! IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values1653 ! !1654 ! ! WARNING pt2d is defined only between nld and nle1655 ! 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 DO1660 ! 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 DO1665 ! !1666 ! ELSE ! standard close or cyclic treatment1667 ! !1668 ! ! ! East-West boundaries1669 ! IF( nbondi == 2 .AND. & ! Cyclic east-west1670 ! & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN1671 ! pt2d( 1 ,:) = pt2d(jpim1,:) ! west1672 ! pt2d(jpi,:) = pt2d( 2 ,:) ! east1673 ! ELSE ! closed1674 ! IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point1675 ! pt2d(nlci-jpreci+1:jpi ,:) = zland ! north1676 ! ENDIF1677 ! ! ! North-South boundaries (always closed)1678 ! IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point1679 ! pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north1680 ! !1681 ! ENDIF1682 1683 1618 ! 2. East and west directions exchange 1684 1619 ! ------------------------------------ 1685 1620 ! we play with the neigbours AND the row number because of the periodicity 1686 1621 ! 1687 SELECT CASE ( nbondi ) ! Read Dirichletlateral conditions1622 SELECT CASE ( nbondi ) ! Read lateral conditions 1688 1623 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 1689 1624 iihom = nlci - jpreci … … 1715 1650 END SELECT 1716 1651 ! 1717 ! ! Write Dirichletlateral conditions1652 ! ! Write lateral conditions 1718 1653 iihom = nlci-nreci 1719 1654 ! … … 1739 1674 ! always closed : we play only with the neigbours 1740 1675 ! 1741 IF( nbondj /= 2 ) THEN ! Read Dirichletlateral conditions1676 IF( nbondj /= 2 ) THEN ! Read lateral conditions 1742 1677 ijhom = nlcj - jprecj 1743 1678 DO jl = 1, jprecj … … 1768 1703 END SELECT 1769 1704 ! 1770 ! ! Write Dirichletlateral conditions1705 ! ! Write lateral conditions 1771 1706 ijhom = nlcj-nrecj 1772 1707 ! … … 1802 1737 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 1803 1738 ! 1804 END SUBROUTINE mpp_ sum_2d1739 END SUBROUTINE mpp_lnk_sum_2d 1805 1740 1806 1741 SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req ) -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r5619 r5779 111 111 zcoef = z_fwf * rcp 112 112 emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) 113 sfx(:,:) = sfx(:,:) + z_fwf * sss_m * tmask(:,:,1)114 113 qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 115 114 ENDIF -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5619 r5779 63 63 64 64 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 ? 66 66 REAL(wp), PUBLIC, SAVE :: rhoisf = 920.0_wp ! phycst ? 67 67 REAL(wp), PUBLIC, SAVE :: tsurf = -20.0_wp ! phycst ? … … 152 152 !: read effective lenght (BG03) 153 153 IF (nn_isf == 2) THEN 154 cvarLeff = 'soLeff'154 ! Read Data and save some integral values 155 155 CALL iom_open( sn_Leff_isf%clname, inum ) 156 cvarLeff = 'soLeff' !: variable name for Efficient Length scale 156 157 CALL iom_get( inum, jpdom_data, cvarLeff, risfLeff , 1) 157 158 CALL iom_close(inum) … … 297 298 ! 298 299 ! 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 ) 301 302 END IF 302 303 … … 528 529 ! zwflx is upward water flux 529 530 ! 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) 531 532 ! test convergence and compute gammat 532 533 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 921 921 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 922 922 & - 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) 924 924 END DO 925 925 END DO … … 1242 1242 ! 1243 1243 rau0 = 1026._wp !: volumic mass of reference [kg/m3] 1244 rcp = 39 74._wp !: heat capacity [J/K]1244 rcp = 3991.86795711963_wp !: heat capacity [J/K] 1245 1245 ! 1246 1246 IF(lwp) THEN ! Control print -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r5619 r5779 102 102 REAL(wp) :: zta, zsa ! local scalars 103 103 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta 104 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dtadmp105 104 !!---------------------------------------------------------------------- 106 105 ! 107 106 IF( nn_timing == 1 ) CALL timing_start( 'tra_dmp') 108 107 ! 109 CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta , zts_dtadmp)108 CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta ) 110 109 ! !== 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 113 111 ! 114 112 SELECT CASE ( nn_zdmp ) !== type of damping ==! … … 176 174 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 177 175 ! 178 CALL wrk_dealloc( jpi, jpj, jpk, jpts, zts_dta , zts_dtadmp)176 CALL wrk_dealloc( jpi, jpj, jpk, jpts, zts_dta ) 179 177 ! 180 178 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 22 22 USE sbcrnf ! River runoff 23 23 USE sbcisf ! Ice shelf 24 USE sbc_iscpl! Ice sheet coupling24 USE iscplini ! Ice sheet coupling 25 25 USE traqsr ! solar radiation penetration 26 26 USE trd_oce ! trends: ocean variables … … 291 291 !---------------------------------------- 292 292 ! 293 IF( ln_iscpl .AND. ln_h fb) THEN ! input of heat and salt due to river runoff293 IF( ln_iscpl .AND. ln_hsb) THEN ! input of heat and salt due to river runoff 294 294 DO jk = 1,jpk 295 295 DO jj = 2, jpj -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r5619 r5779 163 163 FUNCTION glob_sum_full_2d( ptab ) 164 164 !!---------------------------------------------------------------------- 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) 168 168 !!---------------------------------------------------------------------- 169 169 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 170 REAL(wp) :: glob_sum_full_2d ! global maskedsum170 REAL(wp) :: glob_sum_full_2d ! global sum 171 171 !! 172 172 !!----------------------------------------------------------------------- … … 179 179 FUNCTION glob_sum_full_3d( ptab ) 180 180 !!---------------------------------------------------------------------- 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) 184 184 !!---------------------------------------------------------------------- 185 185 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 186 REAL(wp) :: glob_sum_full_3d ! global maskedsum186 REAL(wp) :: glob_sum_full_3d ! global sum 187 187 !! 188 188 INTEGER :: ji, jj, jk ! dummy loop indices … … 192 192 ijpk = SIZE(ptab,3) 193 193 ! 194 glob_sum_ 3d = 0.e0194 glob_sum_full_3d = 0.e0 195 195 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) ) 197 197 END DO 198 198 IF( lk_mpp ) CALL mpp_sum( glob_sum_full_3d )
Note: See TracChangeset
for help on using the changeset viewer.