Changeset 3002
- Timestamp:
- Oct 3, 2017, 8:18:41 AM (7 years ago)
- Location:
- LMDZ5/trunk/libf
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90
r2786 r3002 131 131 cu,cuvsurcv,cv,cvusurcu, & 132 132 aire,apoln,apols, & 133 aireu,airev )133 aireu,airev,rlatvdyn) 134 134 END IF 135 135 -
LMDZ5/trunk/libf/phylmd/conf_phys_m.F90
r2989 r3002 2419 2419 2420 2420 !--test on ocean surface albedo 2421 IF (iflag_albedo.LT.0.OR.iflag_albedo.GT. 1) THEN2421 IF (iflag_albedo.LT.0.OR.iflag_albedo.GT.2) THEN 2422 2422 WRITE(lunout,*) ' ERROR iflag_albedo<>0,1' 2423 2423 CALL abort_physic('conf_phys','choice iflag_albedo not valid',1) -
LMDZ5/trunk/libf/phylmd/limit_slab.F90
r2656 r3002 8 8 USE netcdf 9 9 USE indice_sol_mod 10 USE ocean_slab_mod, ONLY: nslay 10 11 11 12 IMPLICIT NONE … … 18 19 INTEGER, INTENT(IN) :: jour ! jour a lire dans l'annee 19 20 REAL , INTENT(IN) :: dtime ! pas de temps de la physique (en s) 20 REAL, DIMENSION(klon), INTENT(OUT) :: lmt_bils, diff_sst, diff_siv 21 REAL, DIMENSION(klon), INTENT(OUT) :: diff_sst, diff_siv 22 REAL, DIMENSION(klon,nslay), INTENT(OUT) :: lmt_bils 21 23 22 24 ! Locals variables with attribute SAVE 23 25 !**************************************************************************************** 24 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: bils_save, diff_sst_save25 REAL, DIMENSION(: ), ALLOCATABLE, SAVE :: diff_siv_save26 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: diff_siv_save, diff_sst_save 27 REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: bils_save 26 28 !$OMP THREADPRIVATE(bils_save, diff_sst_save, diff_siv_save) 27 29 … … 31 33 INTEGER :: nvarid, nid, ierr, i 32 34 INTEGER, DIMENSION(2) :: start, epais 33 REAL, DIMENSION(klon_glo):: bils_glo,sst_l_glo, sst_lp1_glo, diff_sst_glo35 REAL, DIMENSION(klon_glo):: sst_l_glo, sst_lp1_glo, diff_sst_glo 34 36 REAL, DIMENSION(klon_glo):: siv_l_glo, siv_lp1_glo, diff_siv_glo 37 REAL, DIMENSION(klon_glo,nslay):: bils_glo 35 38 CHARACTER (len = 20) :: modname = 'limit_slab' 39 CHARACTER*2 str2 36 40 LOGICAL :: read_bils,read_sst,read_siv 37 41 … … 44 48 ! Initialize saved variables 45 49 IF (.NOT. ALLOCATED(bils_save)) THEN 46 ALLOCATE(bils_save(klon ), diff_sst_save(klon), diff_siv_save(klon), stat=ierr)50 ALLOCATE(bils_save(klon,nslay), diff_sst_save(klon), diff_siv_save(klon), stat=ierr) 47 51 IF (ierr /= 0) CALL abort_physic('limit_slab', 'pb in allocation',1) 48 52 END IF … … 77 81 ! 78 82 ! Read bils_glo 79 ierr = NF90_INQ_VARID(nid, 'BILS_OCE', nvarid) 83 bils_glo(:,:)=0. 84 ! First read first layer 85 ! try first "BILS_OCE01" 86 ierr = NF90_INQ_VARID(nid, 'BILS_OCE01', nvarid) 80 87 IF (ierr /= NF90_NOERR) THEN 81 read_bils=.FALSE. 88 ! Else BILS_OCE 89 ierr = NF90_INQ_VARID(nid, 'BILS_OCE', nvarid) 90 IF (ierr /= NF90_NOERR) THEN 91 read_bils=.FALSE. 92 ELSE 93 ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,1),start,epais) 94 IF (ierr /= NF90_NOERR) read_bils=.FALSE. 95 ENDIF 82 96 ELSE 83 ierr = NF90_GET_VAR(nid,nvarid,bils_glo ,start,epais)97 ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,1),start,epais) 84 98 IF (ierr /= NF90_NOERR) read_bils=.FALSE. 85 99 END IF 100 ! Try next layers if more than 1 101 IF ((nslay.GT.1).AND.read_bils) THEN 102 DO i=2,nslay 103 WRITE(str2,'(i2.2)') i 104 ierr = NF90_INQ_VARID(nid,'BILS_OCE'//str2, nvarid) 105 IF (ierr.EQ.NF90_NOERR) THEN 106 ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,i),start,epais) 107 ENDIF 108 IF (ierr /= NF90_NOERR) THEN 109 print *,'WARNING : BILS_OCE not found for layer 2' 110 ENDIF 111 ENDDO 112 ENDIF 113 86 114 ! Read sst_glo for this day 87 115 ierr = NF90_INQ_VARID(nid, 'SST', nvarid) … … 146 174 CALL Scatter(bils_glo, bils_save) 147 175 ELSE 148 bils_save(: )=0.176 bils_save(:,:)=0. 149 177 END IF 150 178 IF (read_sst) THEN … … 161 189 ENDIF ! time to read 162 190 163 lmt_bils(: ) = bils_save(:)191 lmt_bils(:,:) = bils_save(:,:) 164 192 diff_sst(:) = diff_sst_save(:) 165 193 diff_siv(:) = diff_siv_save(:) -
LMDZ5/trunk/libf/phylmd/ocean_slab_mod.F90
r2656 r3002 1 ! 1 !Completed 2 2 MODULE ocean_slab_mod 3 3 ! … … 40 40 REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE :: dt_hdiff 41 41 !$OMP THREADPRIVATE(dt_hdiff) 42 ! heat flux convergence due to GM eddy advection 43 REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE :: dt_gm 44 !$OMP THREADPRIVATE(dt_gm) 45 ! Heat Flux correction 46 REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE :: dt_qflux 47 !$OMP THREADPRIVATE(dt_qflux) 42 48 ! fraction of ocean covered by sea ice (sic / (oce+sic)) 43 49 REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE :: fsic … … 50 56 !$OMP THREADPRIVATE(seaice) 51 57 ! net surface heat flux, weighted by open ocean fraction 52 REAL, ALLOCATABLE, DIMENSION(:), PUBLIC, SAVE :: slab_bils53 !$OMP THREADPRIVATE(slab_bils)54 58 ! slab_bils accumulated over cpl_pas timesteps 55 59 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: bils_cum … … 108 112 LOGICAL, PUBLIC, SAVE :: slab_hdiff 109 113 !$OMP THREADPRIVATE(slab_hdiff) 114 LOGICAL, PUBLIC, SAVE :: slab_gm 115 !$OMP THREADPRIVATE(slab_gm) 110 116 REAL, PRIVATE, SAVE :: coef_hdiff ! coefficient for horizontal diffusion 111 117 !$OMP THREADPRIVATE(coef_hdiff) … … 155 161 ENDIF 156 162 slabh(1)=50. 163 CALL getin_p('slab_depth',slabh(1)) 157 164 IF (nslay.GT.1) THEN 158 165 slabh(2)=150. … … 176 183 slab_ekman=0 177 184 CALL getin_p('slab_ekman',slab_ekman) 185 ! GM eddy advection (2-layers only) 186 slab_gm=.FALSE. 187 CALL getin_p('slab_gm',slab_gm) 188 IF (slab_ekman.LT.2) THEN 189 slab_gm=.FALSE. 190 ENDIF 178 191 ! Convective adjustment 179 192 IF (nslay.EQ.1) THEN … … 205 218 (modname,'pb allocation tslab', 1) 206 219 207 ALLOCATE(slab_bils(klon), stat = error)208 IF (error /= 0) THEN209 abort_message='Pb allocation slab_bils'210 CALL abort_physic(modname,abort_message,1)211 ENDIF212 slab_bils(:) = 0.0213 220 ALLOCATE(bils_cum(klon), stat = error) 214 221 IF (error /= 0) THEN … … 252 259 ENDIF 253 260 261 ALLOCATE(dt_qflux(klon,nslay), stat = error) 262 IF (error /= 0) THEN 263 abort_message='Pb allocation dt_qflux' 264 CALL abort_physic(modname,abort_message,1) 265 ENDIF 266 dt_qflux(:,:) = 0.0 267 268 IF (slab_gm) THEN !GM advection 269 ALLOCATE(dt_gm(klon,nslay), stat = error) 270 IF (error /= 0) THEN 271 abort_message='Pb allocation dt_gm' 272 CALL abort_physic(modname,abort_message,1) 273 ENDIF 274 dt_gm(:,:) = 0.0 275 ENDIF 276 254 277 IF (slab_ekman.GT.0) THEN ! ekman transport 255 278 ALLOCATE(dt_ekman(klon,nslay), stat = error) … … 276 299 IF (slab_hdiff.OR.(slab_ekman.GT.0)) THEN 277 300 CALL gather(zmasq,zmasq_glo) 278 !$OMP MASTER ! Only master thread 301 ! Master thread/process only 302 !$OMP MASTER 279 303 IF (is_mpi_root) THEN 280 304 CALL ini_slab_transp(zmasq_glo) … … 317 341 radsol, snow, & 318 342 qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, & 319 tsurf_new, dflux_s, dflux_l, qflux)343 tsurf_new, dflux_s, dflux_l, slab_bils) 320 344 321 345 USE calcul_fluxs_mod 322 USE slab_heat_transp_mod, ONLY: divgrad_phy, slab_ekman1, slab_ekman2346 USE slab_heat_transp_mod, ONLY: divgrad_phy,slab_ekman1,slab_ekman2,slab_gmdiff 323 347 USE mod_phys_lmdz_para 324 348 … … 369 393 REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new ! new surface tempearture 370 394 REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l 371 REAL, DIMENSION(klon), INTENT(OUT) :: qflux395 REAL, DIMENSION(klon), INTENT(OUT) :: slab_bils 372 396 373 397 ! Local variables … … 378 402 REAL, DIMENSION(klon) :: cal, beta, dif_grnd 379 403 ! for Q-Flux computation: d/dt SST, d/dt ice volume (kg/m2), surf fluxes 380 REAL, DIMENSION(klon) :: diff_sst, diff_siv, lmt_bils 404 REAL, DIMENSION(klon) :: diff_sst, diff_siv 405 REAL, DIMENSION(klon,nslay) :: lmt_bils 381 406 ! for surface wind stress 382 407 REAL, DIMENSION(klon) :: u0, v0 … … 386 411 ! horizontal diffusion and Ekman local vars 387 412 ! dimension = global domain (klon_glo) instead of // subdomains 388 REAL, DIMENSION(klon_glo,nslay) :: dt_hdiff_glo, dt_ekman_glo413 REAL, DIMENSION(klon_glo,nslay) :: dt_hdiff_glo,dt_ekman_glo,dt_gm_glo 389 414 ! dt_ekman_glo saved for diagnostic, dt_ekman_tmp used for time loop 390 415 REAL, DIMENSION(klon_glo,nslay) :: dt_hdiff_tmp, dt_ekman_tmp … … 444 469 ! 445 470 !**************************************************************************************** 446 lmt_bils(:)=0.447 471 CALL limit_slab(itime, dtime, jour, lmt_bils, diff_sst, diff_siv) 448 472 ! lmt_bils and diff_sst,siv saved by limit_slab 449 qflux(:)=lmt_bils(:)+diff_sst(:)/cyang/86400.-diff_siv(:)*ice_den*ice_lat/86400.450 473 ! qflux = total QFlux correction (in W/m2) 474 dt_qflux(:,1)=lmt_bils(:,1)+diff_sst(:)/cyang/86400.-diff_siv(:)*ice_den*ice_lat/86400. 475 IF (nslay.GT.1) THEN 476 dt_qflux(:,2:nslay)=lmt_bils(:,2:nslay) 477 END IF 451 478 452 479 !**************************************************************************************** … … 469 496 CALL gather(tslab,tslab_glo) 470 497 ! Compute horiz transport on one process only 471 !$OMP MASTER ! Only master thread 472 IF (is_mpi_root) THEN ! Only master processus 498 IF (is_mpi_root .AND. is_omp_root) THEN ! Only master processus 473 499 IF (slab_hdiff) THEN 474 500 dt_hdiff_glo(:,:)=0. … … 476 502 IF (slab_ekman.GT.0) THEN 477 503 dt_ekman_glo(:,:)=0. 504 END IF 505 IF (slab_gm) THEN 506 dt_gm_glo(:,:)=0. 478 507 END IF 479 508 DO i=1,cpl_pas ! time splitting for numerical stability … … 483 512 CALL slab_ekman1(taux_glo,tauy_glo,tslab_glo,dt_ekman_tmp) 484 513 CASE (2) 485 CALL slab_ekman2(taux_glo,tauy_glo,tslab_glo,dt_ekman_tmp )514 CALL slab_ekman2(taux_glo,tauy_glo,tslab_glo,dt_ekman_tmp,dt_hdiff_tmp,slab_gm) 486 515 CASE DEFAULT 487 516 dt_ekman_tmp(:,:)=0. … … 493 522 ENDDO 494 523 tslab_glo=tslab_glo+dt_ekman_tmp*dtime 524 IF (slab_gm) THEN ! Gent-McWilliams eddy advection 525 dt_gm_glo(:,:)=dt_gm_glo(:,:)+ dt_hdiff_tmp(:,:) 526 ! convert dt from K.s-1.(kg.m-2) to K.s-1 527 DO k=1,nslay 528 dt_hdiff_tmp(:,k)=dt_hdiff_tmp(:,k)/(slabh(k)*sea_den) 529 END DO 530 tslab_glo=tslab_glo+dt_hdiff_tmp*dtime 531 END IF 495 532 ENDIF 533 ! GM included in Ekman_2 534 ! IF (slab_gm) THEN ! Gent-McWilliams eddy advection 535 ! CALL slab_gmdiff(tslab_glo,dt_hdiff_tmp) 536 ! ! convert dt_gm from K.m.s-1 to K.s-1 537 ! DO k=1,nslay 538 ! dt_hdiff_tmp(:,k)=dt_hdiff_tmp(:,k)/slabh(k) 539 ! END DO 540 ! tslab_glo=tslab_glo+dt_hdiff_tmp*dtime 541 ! dt_gm_glo(:,:)=dt_gm_glo(:,:)+ dt_hdiff_tmp(:,:) 542 ! END IF 496 543 IF (slab_hdiff) THEN ! horizontal diffusion 497 544 ! laplacian of slab T … … 509 556 END DO 510 557 END IF 558 IF (slab_gm) THEN 559 !dt_hdiff_glo saved in W/m2 560 dt_gm_glo(:,:)=dt_gm_glo(:,:)*sea_cap/cpl_pas 561 END IF 511 562 IF (slab_ekman.GT.0) THEN 512 563 ! dt_ekman_glo saved in W/m2 513 564 dt_ekman_glo(:,:)=dt_ekman_glo(:,:)*sea_cap/cpl_pas 514 565 END IF 515 END IF ! is_mpi_root 516 !$OMP END MASTER 566 END IF ! master process 517 567 !$OMP BARRIER 518 568 ! Send new fields back to all processes … … 520 570 IF (slab_hdiff) THEN 521 571 CALL Scatter(dt_hdiff_glo,dt_hdiff) 572 END IF 573 IF (slab_gm) THEN 574 CALL Scatter(dt_gm_glo,dt_gm) 522 575 END IF 523 576 IF (slab_ekman.GT.0) THEN … … 533 586 ! *********************************** 534 587 ! Add read QFlux 535 tslab(:,1)=tslab(:,1)+qflux(:)*cyang*dtime*cpl_pas 588 DO k=1,nslay 589 tslab(:,k)=tslab(:,k)+dt_qflux(:,k)*cyang*dtime*cpl_pas & 590 *slabh(1)/slabh(k) 591 END DO 536 592 ! Add cumulated surface fluxes 537 593 tslab(:,1)=tslab(:,1)+bils_cum(:)*cyang*dtime … … 913 969 IF (ALLOCATED(tice)) DEALLOCATE(tice) 914 970 IF (ALLOCATED(seaice)) DEALLOCATE(seaice) 915 IF (ALLOCATED(slab_bils)) DEALLOCATE(slab_bils)916 971 IF (ALLOCATED(slab_bilg)) DEALLOCATE(slab_bilg) 917 972 IF (ALLOCATED(bilg_cum)) DEALLOCATE(bilg_cum) … … 921 976 IF (ALLOCATED(dt_ekman)) DEALLOCATE(dt_ekman) 922 977 IF (ALLOCATED(dt_hdiff)) DEALLOCATE(dt_hdiff) 978 IF (ALLOCATED(dt_gm)) DEALLOCATE(dt_gm) 979 IF (ALLOCATED(dt_qflux)) DEALLOCATE(dt_qflux) 923 980 924 981 END SUBROUTINE ocean_slab_final -
LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90
r2993 r3002 706 706 TYPE(ctrl_out), SAVE :: o_tslab = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 707 707 'tslab', 'Temperature ocean slab', 'K', (/ ('', i=1, 10) /)) 708 TYPE(ctrl_out), SAVE :: o_tslab1 = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11 /), & 709 'tslab1', 'Temperature ocean slab', 'K', (/ ('', i=1, 10) /)) 710 TYPE(ctrl_out), SAVE :: o_tslab2 = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11 /), & 711 'tslab2', 'Temperature ocean slab', 'K', (/ ('', i=1, 10) /)) 708 712 TYPE(ctrl_out), SAVE :: o_slab_tice = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 709 713 'slab_tice', 'Temperature banquise slab', 'K', (/ ('', i=1, 10) /)) … … 712 716 TYPE(ctrl_out), SAVE :: o_slab_hdiff = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 713 717 'slab_hdiff', 'Horizontal diffusion', 'W/m2', (/ ('', i=1, 10) /)) 718 TYPE(ctrl_out), SAVE :: o_slab_gm = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11 /), & 719 'slab_gm', 'GM eddy advection', 'W/m2', (/ ('', i=1, 10) /)) 714 720 TYPE(ctrl_out), SAVE :: o_slab_ekman = ctrl_out((/ 1, 1, 10, 10, 10, 10, 11, 11, 11, 11/), & 715 721 'slab_ekman', 'Ekman heat transport', 'W/m2', (/ ('', i=1, 10) /)) -
LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90
r2993 r3002 91 91 o_slab_qflux, o_tslab, o_slab_bils, & 92 92 o_slab_bilg, o_slab_sic, o_slab_tice, & 93 o_slab_hdiff, o_slab_ekman, &93 o_slab_hdiff, o_slab_ekman, o_slab_gm, & 94 94 o_weakinv, o_dthmin, o_cldtau, & 95 95 o_cldemi, o_pr_con_l, o_pr_con_i, & … … 329 329 ok_4xCO2atm 330 330 331 USE ocean_slab_mod, ONLY: nslay, tslab, slab_bil s, slab_bilg, tice, &332 s eaice, slab_ekman,slab_hdiff, dt_ekman, dt_hdiff331 USE ocean_slab_mod, ONLY: nslay, tslab, slab_bilg, tice, seaice, & 332 slab_ekman,slab_hdiff,slab_gm,dt_ekman, dt_hdiff, dt_gm, dt_qflux 333 333 USE pbl_surface_mod, ONLY: snow 334 334 USE indice_sol_mod, ONLY: nbsrf … … 1103 1103 ! Output of slab ocean variables 1104 1104 IF (type_ocean=='slab ') THEN 1105 CALL histwrite_phy(o_slab_qflux, slab_wfbils) 1106 CALL histwrite_phy(o_slab_bils, slab_bils) 1105 CALL histwrite_phy(o_slab_bils, slab_wfbils) 1107 1106 IF (nslay.EQ.1) THEN 1108 1107 zx_tmp_fi2d(:)=tslab(:,1) 1109 1108 CALL histwrite_phy(o_tslab, zx_tmp_fi2d) 1109 zx_tmp_fi2d(:)=dt_qflux(:,1) 1110 CALL histwrite_phy(o_slab_qflux, zx_tmp_fi2d) 1110 1111 ELSE 1111 1112 CALL histwrite_phy(o_tslab, tslab(:,1:nslay)) 1113 CALL histwrite_phy(o_slab_qflux, dt_qflux(:,1:nslay)) 1112 1114 ENDIF 1113 1115 IF (version_ocean=='sicINT') THEN … … 1116 1118 CALL histwrite_phy(o_slab_sic, seaice) 1117 1119 ENDIF 1120 IF (slab_gm) THEN 1121 CALL histwrite_phy(o_slab_gm, dt_gm(:,1:nslay)) 1122 END IF 1118 1123 IF (slab_hdiff) THEN 1119 1124 IF (nslay.EQ.1) THEN -
LMDZ5/trunk/libf/phylmd/slab_heat_transp_mod.F90
r2656 r3002 11 11 REAL,SAVE,ALLOCATABLE :: fext(:) ! Coriolis f times cell area 12 12 !$OMP THREADPRIVATE(fext) 13 REAL,SAVE,ALLOCATABLE :: beta(:) ! df/dy 14 !$OMP THREADPRIVATE(beta) 13 15 REAL,SAVE,ALLOCATABLE :: unsairez(:) ! 1/cell area 14 16 !$OMP THREADPRIVATE(unsairez) … … 34 36 !$OMP THREADPRIVATE(airev) 35 37 36 ! Local variables for horiz mass flux in slab37 LOGICAL,SAVE :: alpha_var 38 ! Local parameters for slab transport 39 LOGICAL,SAVE :: alpha_var ! variable coef for deep temp (1 layer) 38 40 !$OMP THREADPRIVATE(alpha_var) 39 LOGICAL,SAVE :: slab_upstream 41 LOGICAL,SAVE :: slab_upstream ! upstream scheme ? (1 layer) 40 42 !$OMP THREADPRIVATE(slab_upstream) 41 43 LOGICAL,SAVE :: slab_sverdrup ! use wind stress curl at equator 44 !$OMP THREADPRIVATE(slab_sverdrup) 45 LOGICAL,SAVE :: slab_tyeq ! use merid wind stress at equator 46 !$OMP THREADPRIVATE(slab_tyeq) 47 LOGICAL,SAVE :: ekman_zonadv ! use zonal advection by Ekman currents 48 !$OMP THREADPRIVATE(ekman_zonadv) 49 LOGICAL,SAVE :: ekman_zonavg ! zonally average wind stress 50 !$OMP THREADPRIVATE(ekman_zonavg) 51 52 REAL,SAVE :: alpham 53 !$OMP THREADPRIVATE(alpham) 54 REAL,SAVE :: gmkappa 55 !$OMP THREADPRIVATE(gmkappa) 56 REAL,SAVE :: gm_smax 57 !$OMP THREADPRIVATE(gm_smax) 58 59 ! geometry variables : f, beta, mask... 42 60 REAL,SAVE,ALLOCATABLE :: zmasqu(:) ! continent mask for zonal mass flux 43 61 !$OMP THREADPRIVATE(zmasqu) … … 46 64 REAL,SAVE,ALLOCATABLE :: unsfv(:) ! 1/f, v points 47 65 !$OMP THREADPRIVATE(unsfv) 66 REAL,SAVE,ALLOCATABLE :: unsbv(:) ! 1/beta 67 !$OMP THREADPRIVATE(unsbv) 48 68 REAL,SAVE,ALLOCATABLE :: unsev(:) ! 1/epsilon (drag) 49 69 !$OMP THREADPRIVATE(unsev) … … 63 83 cu_,cuvsurcv_,cv_,cvusurcu_, & 64 84 aire_,apoln_,apols_, & 65 aireu_,airev_) 85 aireu_,airev_,rlatv) 86 USE comconst_mod, ONLY: omeg, rad 66 87 ! number of points in lon, lat 67 88 IMPLICIT NONE … … 82 103 REAL,INTENT(IN) :: aireu_(ip1jmp1) 83 104 REAL,INTENT(IN) :: airev_(ip1jm) 84 105 REAL,INTENT(IN) :: rlatv(nbp_lat-1) 85 106 86 107 ! Sanity check on dimensions … … 112 133 aireu(:)=aireu_(:) 113 134 allocate(airev(ip1jm)) 114 airev(:)=airev_(:) 135 airev(:)=airev_(:) 136 allocate(beta(nbp_lat-1)) 137 beta(:)=2*omeg*cos(rlatv(:))/rad 115 138 116 139 END SUBROUTINE ini_slab_transp_geom … … 139 162 ip1jmp1=(nbp_lon+1)*nbp_lat 140 163 164 ! Options for Heat transport 165 ! Alpha variable? 166 alpha_var=.FALSE. 167 CALL getin('slab_alphav',alpha_var) 168 print *,'alpha variable',alpha_var 169 ! centered ou upstream scheme for meridional transport 170 slab_upstream=.FALSE. 171 CALL getin('slab_upstream',slab_upstream) 172 print *,'upstream slab scheme',slab_upstream 173 ! Sverdrup balance at equator ? 174 slab_sverdrup=.TRUE. 175 CALL getin('slab_sverdrup',slab_sverdrup) 176 print *,'Sverdrup balance',slab_sverdrup 177 ! Use tauy for meridional flux at equator ? 178 slab_tyeq=.TRUE. 179 CALL getin('slab_tyeq',slab_tyeq) 180 print *,'Tauy forcing at equator',slab_tyeq 181 ! Use tauy for meridional flux at equator ? 182 ekman_zonadv=.TRUE. 183 CALL getin('slab_ekman_zonadv',ekman_zonadv) 184 print *,'Use Ekman flow in zonal direction',ekman_zonadv 185 ! Use tauy for meridional flux at equator ? 186 ekman_zonavg=.FALSE. 187 CALL getin('slab_ekman_zonavg',ekman_zonavg) 188 print *,'Use zonally-averaged wind stress ?',ekman_zonavg 189 ! Value of alpha 190 alpham=2./3. 191 CALL getin('slab_alpha',alpham) 192 print *,'slab_alpha',alpham 193 ! GM k coefficient (m2/s) for 2-layers 194 gmkappa=1000. 195 CALL getin('slab_gmkappa',gmkappa) 196 print *,'slab_gmkappa',gmkappa 197 ! GM k coefficient (m2/s) for 2-layers 198 gm_smax=2e-3 199 CALL getin('slab_gm_smax',gm_smax) 200 print *,'slab_gm_smax',gm_smax 201 ! ----------------------------------------------------------- 141 202 ! Define ocean / continent mask (no flux into continent cell) 142 203 allocate(zmasqu(ip1jmp1)) … … 161 222 END IF 162 223 END DO 224 225 ! ----------------------------------------------------------- 226 ! Coriolis and friction for Ekman transport 163 227 slab_ekman=2 164 228 CALL getin("slab_ekman",slab_ekman) 165 ! Coriolis and friction for Ekman transport166 229 IF (slab_ekman.GT.0) THEN 167 230 allocate(unsfv(ip1jm)) … … 169 232 allocate(unsfu(ip1jmp1)) 170 233 allocate(unseu(ip1jmp1)) 234 allocate(unsbv(ip1jm)) 171 235 172 236 eps=1e-5 ! Drag … … 176 240 ! coefs to convert tau_x, tau_y to Ekman mass fluxes 177 241 ! on 2D grid v points 242 ! Compute correction factor [0 1] near the equator (f<<eps) 243 IF (slab_sverdrup) THEN 244 ! New formulation, sharper near equator, when eps gives Rossby Radius 245 DO i=1,ip1jm 246 unsev(i)=exp(-ff(i)*ff(i)/eps**2) 247 ENDDO 248 ELSE 249 DO i=1,ip1jm 250 unsev(i)=eps**2/(ff(i)*ff(i)+eps**2) 251 ENDDO 252 END IF ! slab_sverdrup 253 ! 1/beta 254 DO i=1,jjp1-1 255 unsbv((i-1)*iip1+1:i*iip1)=unsev((i-1)*iip1+1:i*iip1)/beta(i) 256 END DO 257 ! 1/f 258 ff=SIGN(MAX(ABS(ff),eps/100.),ff) ! avoid value 0 at equator... 178 259 DO i=1,ip1jm 179 unsev(i)=eps/(ff(i)*ff(i)+eps**2) 180 unsfv(i)=ff(i)/(ff(i)*ff(i)+eps**2) 181 ENDDO 260 unsfv(i)=(1.-unsev(i))/ff(i) 261 END DO 182 262 ! compute values on 2D u grid 263 ! 1/eps 264 unsev(:)=unsev(:)/eps 183 265 CALL gr_v_scal(1,unsfv,unsfu) 184 266 CALL gr_v_scal(1,unsev,unseu) 185 267 END IF 186 187 ! Other options for Ekman transport188 ! Alpha variable?189 alpha_var=.FALSE.190 CALL getin('slab_alphav',alpha_var)191 print *,'alpha variable',alpha_var192 ! centered ou upstream scheme for meridional transport193 slab_upstream=.FALSE.194 CALL getin('slab_upstream',slab_upstream)195 print *,'upstream slab scheme',slab_upstream196 268 197 269 END SUBROUTINE ini_slab_transp … … 249 321 REAL tyu((nbp_lon+1)*nbp_lat),txu((nbp_lon+1)*nbp_lat) 250 322 REAL txv((nbp_lon+1)*(nbp_lat-1)),tyv((nbp_lon+1)*(nbp_lat-1)) 323 REAL tcurl((nbp_lon+1)*(nbp_lat-1)) 251 324 ! zonal and meridional Ekman mass fluxes at u, v points (2D grid) 252 325 REAL fluxz((nbp_lon+1)*nbp_lat),fluxm((nbp_lon+1)*(nbp_lat-1)) … … 272 345 ! First and last points in zonal direction are the same 273 346 ! we use 1 index ij from 1 to (iim+1)*(jjm+1) 347 ! north and south poles 348 tx_phy(1)=0. 349 tx_phy(klon_glo)=0. 350 ty_phy(1)=0. 351 ty_phy(klon_glo)=0. 274 352 CALL gr_fi_dyn(1,iip1,jjp1,tx_phy,txu) 275 353 CALL gr_fi_dyn(1,iip1,jjp1,ty_phy,tyu) … … 278 356 ! Meridional mass flux 279 357 CALL gr_scal_v(1,txu,txv) ! wind stress at v points 280 CALL gr_scal_v(1,tyu,tyv) 281 fluxm=tyv*unsev-txv*unsfv ! in kg.s-1.m-1 (zonal distance) 358 IF (slab_sverdrup) THEN ! Sverdrup bal. near equator 359 tcurl=(txu(1:ip1jm)-txu(iip2:ip1jmp1))/cv(:) 360 fluxm=-tcurl*unsbv-txv*unsfv ! in kg.s-1.m-1 (zonal distance) 361 ELSE 362 CALL gr_scal_v(1,tyu,tyv) 363 fluxm=tyv*unsev-txv*unsfv ! in kg.s-1.m-1 (zonal distance) 364 ENDIF 282 365 ! Zonal mass flux 283 366 CALL gr_scal_u(1,txu,txu) ! wind stress at u points … … 316 399 ! to avoid "hot spots" where there is surface convergence 317 400 DO ij=iip2,ip1jm 318 alpha(ij)= 2./3.-fluxv(ij)/fluxt(ij)/3.401 alpha(ij)=alpham-fluxv(ij)/fluxt(ij)*(1.-alpham) 319 402 ENDDO 320 alpha(1:iip1)= 2./3.-fluxv(1)/fluxt(1)/3.321 alpha(ip1jm+1:ip1jmp1)= 2./3.-fluxv(ip1jmp1)/fluxt(ip1jmp1)/3.403 alpha(1:iip1)=alpham-fluxv(1)/fluxt(1)*(1.-alpham) 404 alpha(ip1jm+1:ip1jmp1)=alpham-fluxv(ip1jmp1)/fluxt(ip1jmp1)*(1.-alpham) 322 405 ELSE 323 alpha(:)= 2./3.406 alpha(:)=alpham 324 407 ! Tsurf-Tdeep ~ 10° in the Tropics 325 408 ENDIF … … 380 463 END SUBROUTINE slab_ekman1 381 464 382 SUBROUTINE slab_ekman2(tx_phy,ty_phy,ts_phy,dt_phy )465 SUBROUTINE slab_ekman2(tx_phy,ty_phy,ts_phy,dt_phy_ek,dt_phy_gm,slab_gm) 383 466 ! Temperature tendency for 2-layers slab ocean 384 467 ! note : tendency dt later multiplied by (delta time)/(rho.H) 385 468 ! to convert from divergence of heat fluxes to T 469 470 ! 11/16 : Inclusion of GM-like eddy advection 471 472 IMPLICIT NONE 473 474 LOGICAL,INTENT(in) :: slab_gm 475 ! Here, temperature and flux variables are on 2 layers 476 INTEGER ij 477 478 ! wind stress variables 479 REAL tx_phy(klon_glo),ty_phy(klon_glo) 480 REAL txv((nbp_lon+1)*(nbp_lat-1)), tyv((nbp_lon+1)*(nbp_lat-1)) 481 REAL tyu((nbp_lon+1)*nbp_lat),txu((nbp_lon+1)*nbp_lat) 482 REAL tcurl((nbp_lon+1)*(nbp_lat-1)) 483 ! slab temperature on 1D, 2D grid 484 REAL ts_phy(klon_glo,2), ts((nbp_lon+1)*nbp_lat,2) 485 ! Temperature gradient, v-points 486 REAL dty((nbp_lon+1)*(nbp_lat-1)),dtx((nbp_lon+1)*nbp_lat) 487 ! Vertical temperature difference, V-points 488 REAL dtz((nbp_lon+1)*(nbp_lat-1)) 489 ! zonal and meridional mass fluxes at u, v points (2D grid) 490 REAL fluxz((nbp_lon+1)*nbp_lat), fluxm((nbp_lon+1)*(nbp_lat-1)) 491 ! vertical mass flux between the 2 layers 492 REAL fluxv_ek((nbp_lon+1)*nbp_lat) 493 REAL fluxv_gm((nbp_lon+1)*nbp_lat) 494 ! zonal and meridional heat fluxes 495 REAL fluxtz((nbp_lon+1)*nbp_lat,2) 496 REAL fluxtm((nbp_lon+1)*(nbp_lat-1),2) 497 ! temperature tendency (in K.s-1.kg.m-2) 498 REAL dt_ek((nbp_lon+1)*nbp_lat,2), dt_phy_ek(klon_glo,2) 499 REAL dt_gm((nbp_lon+1)*nbp_lat,2), dt_phy_gm(klon_glo,2) 500 ! helper vars 501 REAL zonavg, fluxv 502 REAL, PARAMETER :: sea_den=1025. ! sea water density 503 504 INTEGER iim,iip1,iip2,jjp1,ip1jm,ip1jmi1,ip1jmp1 505 506 ! Grid definitions 507 iim=nbp_lon 508 iip1=nbp_lon+1 509 iip2=nbp_lon+2 510 jjp1=nbp_lat 511 ip1jm=(nbp_lon+1)*(nbp_lat-1) ! = iip1*jjm 512 ip1jmi1=(nbp_lon+1)*(nbp_lat-1)-(nbp_lon+1) ! = ip1jm - iip1 513 ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1 514 ! Convert temperature to 2D grid 515 CALL gr_fi_dyn(2,iip1,jjp1,ts_phy,ts) 516 517 ! ------------------------------------ 518 ! Ekman mass fluxes and Temp tendency 519 ! ------------------------------------ 520 ! Convert taux,y to 2D scalar grid 521 ! north and south poles tx,ty no meaning 522 tx_phy(1)=0. 523 tx_phy(klon_glo)=0. 524 ty_phy(1)=0. 525 ty_phy(klon_glo)=0. 526 CALL gr_fi_dyn(1,iip1,jjp1,tx_phy,txu) 527 CALL gr_fi_dyn(1,iip1,jjp1,ty_phy,tyu) 528 IF (ekman_zonavg) THEN ! use zonal average of wind stress 529 DO ij=1,jjp1-2 530 zonavg=SUM(txu(ij*iip1+1:ij*iip1+iim))/iim 531 txu(ij*iip1+1:(ij+1)*iip1)=zonavg 532 zonavg=SUM(tyu(ij*iip1+1:ij*iip1+iim))/iim 533 tyu(ij*iip1+1:(ij+1)*iip1)=zonavg 534 END DO 535 END IF 536 537 ! Divide taux,y by f or eps, and convert to 2D u,v grids 538 ! (Arakawa C grid) 539 ! Meridional flux 540 CALL gr_scal_v(1,txu,txv) ! wind stress at v points 541 fluxm=-txv*unsfv ! in kg.s-1.m-1 (zonal distance) 542 IF (slab_sverdrup) THEN ! Sverdrup bal. near equator 543 tcurl=(txu(1:ip1jm)-txu(iip2:ip1jmp1))/cv(:) ! dtx/dy 544 !poles curl = 0 545 tcurl(1:iip1)=0. 546 tcurl(ip1jmi1+1:ip1jm)=0. 547 fluxm=fluxm-tcurl*unsbv 548 ENDIF 549 IF (slab_tyeq) THEN ! meridional wind forcing at equator 550 CALL gr_scal_v(1,tyu,tyv) 551 fluxm=fluxm+tyv*unsev ! in kg.s-1.m-1 (zonal distance) 552 ENDIF 553 ! apply continent mask, multiply by horiz grid dimension 554 fluxm=fluxm*cv*cuvsurcv*zmasqv 555 556 ! Zonal flux 557 IF (ekman_zonadv) THEN 558 CALL gr_scal_u(1,txu,txu) ! wind stress at u points 559 CALL gr_scal_u(1,tyu,tyu) 560 fluxz=tyu*unsfu+txu*unseu 561 ! apply continent mask, multiply by horiz grid dimension 562 fluxz=fluxz*cu*cvusurcu*zmasqu 563 END IF 564 565 ! Vertical mass flux from mass budget (divergence of horiz fluxes) 566 IF (ekman_zonadv) THEN 567 DO ij=iip2,ip1jm 568 fluxv_ek(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1) 569 ENDDO 570 ELSE 571 DO ij=iip2,ip1jm 572 fluxv_ek(ij)=-fluxm(ij)+fluxm(ij-iip1) 573 ENDDO 574 END IF 575 DO ij=iip1,ip1jmi1,iip1 576 fluxv_ek(ij+1)=fluxv_ek(ij+iip1) 577 END DO 578 ! vertical mass flux at Poles 579 fluxv_ek(1)=-SUM(fluxm(1:iim)) 580 fluxv_ek(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1)) 581 582 ! Meridional heat fluxes 583 DO ij=1,ip1jm 584 ! centered scheme 585 fluxtm(ij,1)=fluxm(ij)*(ts(ij+iip1,1)+ts(ij,1))/2. 586 fluxtm(ij,2)=-fluxm(ij)*(ts(ij+iip1,2)+ts(ij,2))/2. 587 END DO 588 589 ! Zonal heat fluxes 590 ! Schema upstream 591 IF (ekman_zonadv) THEN 592 DO ij=iip2,ip1jm 593 IF (fluxz(ij).GE.0.) THEN 594 fluxtz(ij,1)=fluxz(ij)*ts(ij,1) 595 fluxtz(ij,2)=-fluxz(ij)*ts(ij+1,2) 596 ELSE 597 fluxtz(ij,1)=fluxz(ij)*ts(ij+1,1) 598 fluxtz(ij,2)=-fluxz(ij)*ts(ij,2) 599 ENDIF 600 ENDDO 601 DO ij=iip1*2,ip1jmp1,iip1 602 fluxtz(ij,:)=fluxtz(ij-iim,:) 603 END DO 604 ELSE 605 fluxtz(:,:)=0. 606 ENDIF 607 608 ! Temperature tendency, horizontal advection: 609 DO ij=iip2,ip1jm 610 dt_ek(ij,:)=fluxtz(ij-1,:)-fluxtz(ij,:) & 611 +fluxtm(ij,:)-fluxtm(ij-iip1,:) 612 END DO 613 ! Poles 614 dt_ek(1,:)=SUM(fluxtm(1:iim,:),dim=1) 615 dt_ek(ip1jmp1,:)=-SUM(fluxtm(ip1jm-iim:ip1jm-1,:),dim=1) 616 617 ! ------------------------------------ 618 ! GM mass fluxes and Temp tendency 619 ! ------------------------------------ 620 IF (slab_gm) THEN 621 ! Vertical Temperature difference T1-T2 on v-grid points 622 CALL gr_scal_v(1,ts(:,1)-ts(:,2),dtz) 623 dtz(:)=MAX(dtz(:),0.25) 624 ! Horizontal Temperature differences 625 CALL grad(1,(ts(:,1)+ts(:,2))/2.,dtx,dty) 626 ! Meridional flux = -k.s (s=dyT/dzT) 627 ! Continent mask, multiply by dz/dy 628 fluxm=dty/dtz*500.*cuvsurcv*zmasqv 629 ! slope limitation, multiply by kappa 630 fluxm=-gmkappa*SIGN(MIN(ABS(fluxm),gm_smax*cv*cuvsurcv),dty) 631 ! convert to kg/s 632 fluxm(:)=fluxm(:)*sea_den 633 ! Zonal flux = 0. (temporary) 634 fluxz(:)=0. 635 ! Vertical mass flux from mass budget (divergence of horiz fluxes) 636 DO ij=iip2,ip1jm 637 fluxv_gm(ij)=fluxz(ij)-fluxz(ij-1)-fluxm(ij)+fluxm(ij-iip1) 638 ENDDO 639 DO ij=iip1,ip1jmi1,iip1 640 fluxv_gm(ij+1)=fluxv_gm(ij+iip1) 641 END DO 642 ! vertical mass flux at Poles 643 fluxv_gm(1)=-SUM(fluxm(1:iim)) 644 fluxv_gm(ip1jmp1)=SUM(fluxm(ip1jm-iim:ip1jm-1)) 645 646 ! Meridional heat fluxes 647 DO ij=1,ip1jm 648 ! centered scheme 649 fluxtm(ij,1)=fluxm(ij)*(ts(ij+iip1,1)+ts(ij,1))/2. 650 fluxtm(ij,2)=-fluxm(ij)*(ts(ij+iip1,2)+ts(ij,2))/2. 651 END DO 652 653 ! Zonal heat fluxes 654 ! Schema upstream 655 DO ij=iip2,ip1jm 656 IF (fluxz(ij).GE.0.) THEN 657 fluxtz(ij,1)=fluxz(ij)*ts(ij,1) 658 fluxtz(ij,2)=-fluxz(ij)*ts(ij+1,2) 659 ELSE 660 fluxtz(ij,1)=fluxz(ij)*ts(ij+1,1) 661 fluxtz(ij,2)=-fluxz(ij)*ts(ij,2) 662 ENDIF 663 ENDDO 664 DO ij=iip1*2,ip1jmp1,iip1 665 fluxtz(ij,:)=fluxtz(ij-iim,:) 666 END DO 667 668 ! Temperature tendency : 669 ! divergence of horizontal heat fluxes 670 DO ij=iip2,ip1jm 671 dt_gm(ij,:)=fluxtz(ij-1,:)-fluxtz(ij,:) & 672 +fluxtm(ij,:)-fluxtm(ij-iip1,:) 673 END DO 674 ! Poles 675 dt_gm(1,:)=SUM(fluxtm(1:iim,:),dim=1) 676 dt_gm(ip1jmp1,:)=-SUM(fluxtm(ip1jm-iim:ip1jm-1,:),dim=1) 677 ELSE 678 dt_gm(:,:)=0. 679 fluxv_gm(:)=0. 680 ENDIF ! slab_gm 681 682 ! ------------------------------------ 683 ! Temp tendency from vertical advection 684 ! Divide by cell area 685 ! ------------------------------------ 686 ! vertical heat flux = mass flux * T, upstream scheme 687 DO ij=iip2,ip1jm 688 fluxv=fluxv_ek(ij)+fluxv_gm(ij) ! net flux, needed for upstream scheme 689 IF (fluxv.GT.0.) THEN 690 dt_ek(ij,1)=dt_ek(ij,1)+fluxv_ek(ij)*ts(ij,2) 691 dt_ek(ij,2)=dt_ek(ij,2)-fluxv_ek(ij)*ts(ij,2) 692 dt_gm(ij,1)=dt_gm(ij,1)+fluxv_gm(ij)*ts(ij,2) 693 dt_gm(ij,2)=dt_gm(ij,2)-fluxv_gm(ij)*ts(ij,2) 694 ELSE 695 dt_ek(ij,1)=dt_ek(ij,1)+fluxv_ek(ij)*ts(ij,1) 696 dt_ek(ij,2)=dt_ek(ij,2)-fluxv_ek(ij)*ts(ij,1) 697 dt_gm(ij,1)=dt_gm(ij,1)+fluxv_gm(ij)*ts(ij,1) 698 dt_gm(ij,2)=dt_gm(ij,2)-fluxv_gm(ij)*ts(ij,1) 699 ENDIF 700 ! divide by cell area 701 dt_ek(ij,:)=dt_ek(ij,:)/aire(ij) 702 dt_gm(ij,:)=dt_gm(ij,:)/aire(ij) 703 END DO 704 ! North Pole 705 fluxv=fluxv_ek(1)+fluxv_gm(1) 706 IF (fluxv.GT.0.) THEN 707 dt_ek(1,1)=dt_ek(1,1)+fluxv_ek(1)*ts(1,2) 708 dt_ek(1,2)=dt_ek(1,2)-fluxv_ek(1)*ts(1,2) 709 dt_gm(1,1)=dt_gm(1,1)+fluxv_gm(1)*ts(1,2) 710 dt_gm(1,2)=dt_gm(1,2)-fluxv_gm(1)*ts(1,2) 711 ELSE 712 dt_ek(1,1)=dt_ek(1,1)+fluxv_ek(1)*ts(1,1) 713 dt_ek(1,2)=dt_ek(1,2)-fluxv_ek(1)*ts(1,1) 714 dt_gm(1,1)=dt_gm(1,1)+fluxv_gm(1)*ts(1,1) 715 dt_gm(1,2)=dt_gm(1,2)-fluxv_gm(1)*ts(1,1) 716 ENDIF 717 dt_ek(1,:)=dt_ek(1,:)/apoln 718 dt_gm(1,:)=dt_gm(1,:)/apoln 719 ! South pole 720 fluxv=fluxv_ek(ip1jmp1)+fluxv_gm(ip1jmp1) 721 IF (fluxv.GT.0.) THEN 722 dt_ek(ip1jmp1,1)=dt_ek(ip1jmp1,1)+fluxv_ek(ip1jmp1)*ts(ip1jmp1,2) 723 dt_ek(ip1jmp1,2)=dt_ek(ip1jmp1,2)-fluxv_ek(ip1jmp1)*ts(ip1jmp1,2) 724 dt_gm(ip1jmp1,1)=dt_gm(ip1jmp1,1)+fluxv_gm(ip1jmp1)*ts(ip1jmp1,2) 725 dt_gm(ip1jmp1,2)=dt_gm(ip1jmp1,2)-fluxv_gm(ip1jmp1)*ts(ip1jmp1,2) 726 ELSE 727 dt_ek(ip1jmp1,1)=dt_ek(ip1jmp1,1)+fluxv_ek(ip1jmp1)*ts(ip1jmp1,1) 728 dt_ek(ip1jmp1,2)=dt_ek(ip1jmp1,2)-fluxv_ek(ip1jmp1)*ts(ip1jmp1,1) 729 dt_gm(ip1jmp1,1)=dt_gm(ip1jmp1,1)+fluxv_gm(ip1jmp1)*ts(ip1jmp1,1) 730 dt_gm(ip1jmp1,2)=dt_gm(ip1jmp1,2)-fluxv_gm(ip1jmp1)*ts(ip1jmp1,1) 731 ENDIF 732 dt_ek(ip1jmp1,:)=dt_ek(ip1jmp1,:)/apols 733 dt_gm(ip1jmp1,:)=dt_gm(ip1jmp1,:)/apols 734 735 dt_ek(2:iip1,1)=dt_ek(1,1) 736 dt_ek(2:iip1,2)=dt_ek(1,2) 737 dt_gm(2:iip1,1)=dt_gm(1,1) 738 dt_gm(2:iip1,2)=dt_gm(1,2) 739 dt_ek(ip1jm+1:ip1jmp1,1)=dt_ek(ip1jmp1,1) 740 dt_ek(ip1jm+1:ip1jmp1,2)=dt_ek(ip1jmp1,2) 741 dt_gm(ip1jm+1:ip1jmp1,1)=dt_gm(ip1jmp1,1) 742 dt_gm(ip1jm+1:ip1jmp1,2)=dt_gm(ip1jmp1,2) 743 744 DO ij=iip1,ip1jmi1,iip1 745 dt_gm(ij+1,:)=dt_gm(ij+iip1,:) 746 dt_ek(ij+1,:)=dt_ek(ij+iip1,:) 747 END DO 748 749 ! T tendency back to 1D grid... 750 CALL gr_dyn_fi(2,iip1,jjp1,dt_ek,dt_phy_ek) 751 CALL gr_dyn_fi(2,iip1,jjp1,dt_gm,dt_phy_gm) 752 753 RETURN 754 END SUBROUTINE slab_ekman2 755 756 SUBROUTINE slab_gmdiff(ts_phy,dt_phy) 757 ! Temperature tendency for 2-layers slab ocean 758 ! Due to Gent-McWilliams type eddy-induced advection 386 759 387 760 IMPLICIT NONE … … 389 762 ! Here, temperature and flux variables are on 2 layers 390 763 INTEGER ij 391 392 REAL tx_phy(klon_glo),ty_phy(klon_glo)393 REAL txv((nbp_lon+1)*(nbp_lat-1)), tyv((nbp_lon+1)*(nbp_lat-1))394 REAL tyu((nbp_lon+1)*nbp_lat),txu((nbp_lon+1)*nbp_lat)764 ! Temperature gradient, v-points 765 REAL dty((nbp_lon+1)*(nbp_lat-1)),dtx((nbp_lon+1)*nbp_lat) 766 ! Vertical temperature difference, V-points 767 REAL dtz((nbp_lon+1)*(nbp_lat-1)) 395 768 ! slab temperature on 1D, 2D grid 396 REAL ts_phy(klon_glo,2), 397 ! zonal and meridional Ekman mass fluxat u, v points (2D grid)769 REAL ts_phy(klon_glo,2),ts((nbp_lon+1)*nbp_lat,2) 770 ! zonal and meridional mass fluxes at u, v points (2D grid) 398 771 REAL fluxz((nbp_lon+1)*nbp_lat), fluxm((nbp_lon+1)*(nbp_lat-1)) 399 772 ! vertical mass flux between the 2 layers … … 416 789 ip1jmp1=(nbp_lon+1)*nbp_lat ! = iip1*jjp1 417 790 418 ! Convert taux,y to 2D scalar grid419 CALL gr_fi_dyn(1,iip1,jjp1,tx_phy,txu)420 CALL gr_fi_dyn(1,iip1,jjp1,ty_phy,tyu)421 ! Multiply taux,y by f or eps, and convert to 2D u,v grids422 ! (Arakawa C grid)423 ! Meridional flux424 CALL gr_scal_v(1,txu,txv) ! wind stress at v points425 CALL gr_scal_v(1,tyu,tyv)426 fluxm=tyv*unsev-txv*unsfv427 ! Zonal flux428 CALL gr_scal_u(1,txu,txu) ! wind stress at u points429 CALL gr_scal_u(1,tyu,tyu)430 fluxz=tyu*unsfu+txu*unseu431 432 791 ! Convert temperature to 2D grid 433 792 CALL gr_fi_dyn(2,iip1,jjp1,ts_phy,ts) 434 435 ! Mass fluxes (apply continent mask, multiply by horiz grid dimension) 436 fluxm=fluxm*cv*cuvsurcv*zmasqv 437 fluxz=fluxz*cu*cvusurcu*zmasqu 793 ! Vertical Temperature difference T1-T2 on v-grid points 794 CALL gr_scal_v(1,ts(:,1)-ts(:,2),dtz) 795 dtz(:)=MAX(dtz(:),0.25) 796 ! Horizontal Temperature differences 797 CALL grad(1,(ts(:,1)+ts(:,2))/2.,dtx,dty) 798 ! Meridional flux = -k.s (s=dyT/dzT) 799 ! Continent mask, multiply by dz/dy 800 fluxm=dty/dtz*500.*cuvsurcv*zmasqv 801 ! slope limitation, multiply by kappa 802 fluxm=-gmkappa*SIGN(MIN(ABS(fluxm),gm_smax*cv*cuvsurcv),dty) 803 ! Zonal flux = 0. (temporary) 804 fluxz(:)=0. 438 805 ! Vertical mass flux from mass budget (divergence of horiz fluxes) 439 806 DO ij=iip2,ip1jm … … 489 856 dt(ij+1,:)=dt(ij+iip1,:) 490 857 END DO 491 ! P ôles858 ! Poles 492 859 dt(1,:)=SUM(fluxtm(1:iim,:),dim=1) 493 860 IF (fluxv(1).GT.0.) THEN … … 517 884 518 885 RETURN 519 END SUBROUTINE slab_ ekman2886 END SUBROUTINE slab_gmdiff 520 887 521 888 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -
LMDZ5/trunk/libf/phylmd/surf_ocean_mod.F90
r2719 r3002 29 29 USE ocean_cpl_mod, ONLY : ocean_cpl_noice 30 30 USE indice_sol_mod, ONLY : nbsrf, is_oce 31 USE limit_read_mod 31 32 ! 32 33 ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force, … … 91 92 REAL :: tmp 92 93 REAL, PARAMETER :: cepdu2=(0.1)**2 93 REAL, DIMENSION(klon) :: alb_eau 94 REAL, DIMENSION(klon) :: alb_eau, z0_lim 94 95 REAL, DIMENSION(klon) :: radsol 95 96 REAL, DIMENSION(klon) :: cdragq ! Cdrag pour l'evaporation … … 123 124 cdragq(1:knon)=cdragh(1:knon) 124 125 ENDIF 126 125 127 126 128 !****************************************************************************** … … 224 226 alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0) 225 227 ! 228 ! F. Codron albedo read from limit.nc 229 ELSE IF (iflag_albedo==2) THEN 230 CALL limit_read_rug_alb(itime, dtime, jour,& 231 knon, knindex, z0_lim, alb_eau) 232 DO i =1, knon 233 DO k=1,nsw 234 alb_dir_new(i,k) = alb_eau(i) 235 ENDDO 236 ENDDO 237 alb_dif_new=alb_dir_new 226 238 ENDIF 227 239 !albedo SB <<<
Note: See TracChangeset
for help on using the changeset viewer.