Changeset 5878 for LMDZ6/branches
- Timestamp:
- Nov 21, 2025, 6:25:43 PM (25 hours ago)
- Location:
- LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd
- Files:
-
- 2 edited
-
climb_hq_mod.f90 (modified) (12 diffs)
-
pbl_surface_mod.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/climb_hq_mod.f90
r5868 r5878 8 8 IMPLICIT NONE 9 9 PRIVATE 10 PUBLIC :: climb_hq_down, climb_hq_up 10 PUBLIC :: climb_hq_down, climb_hq_up, climb_hq_init, climb_hq_finalize 11 11 12 12 REAL, DIMENSION(:,:), ALLOCATABLE :: gamaq, gamah … … 28 28 REAL, SAVE, DIMENSION(:), ALLOCATABLE :: f_h_bnd ! for diagnostics, enthalpy flux at surface 29 29 !$OMP THREADPRIVATE(f_h_bnd) 30 30 31 31 CONTAINS 32 32 ! 33 33 !**************************************************************************************** 34 34 ! 35 SUBROUTINE climb_hq_init 36 USE dimphy, ONLY : klon, klev 37 IMPLICIT NONE 38 INTEGER :: ierr 39 40 ALLOCATE(Ccoef_Q(klon,klev), STAT=ierr) 41 IF ( ierr /= 0 ) PRINT*,' pb in allloc Ccoef_Q, ierr=', ierr 42 Ccoef_Q(:,:) = 0. 43 44 ALLOCATE(Dcoef_Q(klon,klev), STAT=ierr) 45 IF ( ierr /= 0 ) PRINT*,' pb in allloc Dcoef_Q, ierr=', ierr 46 Dcoef_Q(:,:) = 0. 47 48 ALLOCATE(Ccoef_H(klon,klev), STAT=ierr) 49 IF ( ierr /= 0 ) PRINT*,' pb in allloc Ccoef_H, ierr=', ierr 50 Ccoef_H(:,:) = 0. 51 52 ALLOCATE(Dcoef_H(klon,klev), STAT=ierr) 53 IF ( ierr /= 0 ) PRINT*,' pb in allloc Dcoef_H, ierr=', ierr 54 Dcoef_H(:,:) = 0. 55 56 ALLOCATE(Acoef_Q(klon), Bcoef_Q(klon), Acoef_H(klon), Bcoef_H(klon), STAT=ierr) 57 IF ( ierr /= 0 ) PRINT*,' pb in allloc Acoef_X and Bcoef_X, ierr=', ierr 58 Acoef_Q(:)=0. ; Bcoef_Q(:)=0. ; Acoef_H(:)=0. ; Bcoef_H(:)=0. ; 59 60 ALLOCATE(Kcoefhq(klon,klev), STAT=ierr) 61 IF ( ierr /= 0 ) PRINT*,' pb in allloc Kcoefhq, ierr=', ierr 62 Kcoefhq(:,:) = 0. 63 64 ALLOCATE(gamaq(1:klon,2:klev), STAT=ierr) 65 IF ( ierr /= 0 ) PRINT*,' pb in allloc gamaq, ierr=', ierr 66 gamaq(:,:) = 0. 67 68 ALLOCATE(gamah(1:klon,2:klev), STAT=ierr) 69 IF ( ierr /= 0 ) PRINT*,' pb in allloc gamah, ierr=', ierr 70 gamah(:,:)=0. 71 72 ALLOCATE(h_old(klon,klev), STAT=ierr) 73 IF ( ierr /= 0 ) PRINT*,' pb in allloc h_old, ierr=', ierr 74 h_old(:,:) = 0. 75 76 ALLOCATE(d_h_col_vdf(klon), STAT=ierr) 77 IF ( ierr /= 0 ) PRINT*,' pb in allloc d_h_col_vdf, ierr=', ierr 78 d_h_col_vdf(:) = 0. 79 80 ALLOCATE(f_h_bnd(klon), STAT=ierr) 81 IF ( ierr /= 0 ) PRINT*,' pb in allloc f_h_bnd, ierr=', ierr 82 f_h_bnd(:) = 0. 83 84 END SUBROUTINE climb_hq_init 85 86 SUBROUTINE climb_hq_finalize 87 IMPLICIT NONE 88 INTEGER :: ierr 89 90 !**************************************************************************************** 91 ! Some deallocations 92 ! 93 !**************************************************************************************** 94 95 DEALLOCATE(Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H,stat=ierr) 96 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H, ierr=', ierr 97 DEALLOCATE(Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H,stat=ierr) 98 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H, ierr=', ierr 99 DEALLOCATE(gamaq, gamah,stat=ierr) 100 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate gamaq, gamah, ierr=', ierr 101 DEALLOCATE(Kcoefhq,stat=ierr) 102 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Kcoefhq, ierr=', ierr 103 DEALLOCATE(h_old, d_h_col_vdf, f_h_bnd, stat=ierr) 104 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate h_old, d_h_col_vdf, f_h_bnd, ierr=', ierr 105 106 END SUBROUTINE climb_hq_finalize 107 35 108 SUBROUTINE climb_hq_down(knon, ni, coefhq, paprs, pplay, & 36 109 delp, temp, q, dtime, & … … 40 113 !!! 41 114 Acoef_H_out, Acoef_Q_out, Bcoef_H_out, Bcoef_Q_out) 115 !$gpum horizontal knon 42 116 43 117 ! This routine calculates recursivly the coefficients C and D … … 78 152 REAL :: yAcoef_Q(knon), yBcoef_Q(knon), yAcoef_H(knon), yBcoef_H(knon) 79 153 REAL :: yKcoefhq(knon,klev) 80 REAL :: ygamaq( 1:knon,2:klev)81 REAL :: ygamah( 1:knon,2:klev)154 REAL :: ygamaq(knon,2:klev) 155 REAL :: ygamah(knon,2:klev) 82 156 REAL :: yh_old(knon,klev) ! for diagnostics, h before solving diffusion 83 157 REAL :: yd_h_col_vdf(knon) ! for diagnostics, vertical integral of enthalpy change … … 87 161 ! Local variables 88 162 !**************************************************************************************** 89 LOGICAL, SAVE :: first=.TRUE.90 !$OMP THREADPRIVATE(first)91 163 ! JLD now renamed h_old and declared in module 92 164 ! REAL, DIMENSION(knon,klev) :: local_H … … 96 168 97 169 98 !**************************************************************************************** 99 ! 1) 100 ! Allocation at first time step only 101 ! 102 !**************************************************************************************** 103 104 IF (first) THEN 105 first=.FALSE. 106 ALLOCATE(Ccoef_Q(klon,klev), STAT=ierr) 107 IF ( ierr /= 0 ) PRINT*,' pb in allloc Ccoef_Q, ierr=', ierr 108 109 ALLOCATE(Dcoef_Q(klon,klev), STAT=ierr) 110 IF ( ierr /= 0 ) PRINT*,' pb in allloc Dcoef_Q, ierr=', ierr 111 112 ALLOCATE(Ccoef_H(klon,klev), STAT=ierr) 113 IF ( ierr /= 0 ) PRINT*,' pb in allloc Ccoef_H, ierr=', ierr 114 115 ALLOCATE(Dcoef_H(klon,klev), STAT=ierr) 116 IF ( ierr /= 0 ) PRINT*,' pb in allloc Dcoef_H, ierr=', ierr 117 118 ALLOCATE(Acoef_Q(klon), Bcoef_Q(klon), Acoef_H(klon), Bcoef_H(klon), STAT=ierr) 119 IF ( ierr /= 0 ) PRINT*,' pb in allloc Acoef_X and Bcoef_X, ierr=', ierr 120 121 ALLOCATE(Kcoefhq(klon,klev), STAT=ierr) 122 IF ( ierr /= 0 ) PRINT*,' pb in allloc Kcoefhq, ierr=', ierr 123 124 ALLOCATE(gamaq(1:klon,2:klev), STAT=ierr) 125 IF ( ierr /= 0 ) PRINT*,' pb in allloc gamaq, ierr=', ierr 126 127 ALLOCATE(gamah(1:klon,2:klev), STAT=ierr) 128 IF ( ierr /= 0 ) PRINT*,' pb in allloc gamah, ierr=', ierr 129 130 ALLOCATE(h_old(klon,klev), STAT=ierr) 131 IF ( ierr /= 0 ) PRINT*,' pb in allloc h_old, ierr=', ierr 132 133 ALLOCATE(d_h_col_vdf(klon), STAT=ierr) 134 IF ( ierr /= 0 ) PRINT*,' pb in allloc d_h_col_vdf, ierr=', ierr 135 136 ALLOCATE(f_h_bnd(klon), STAT=ierr) 137 IF ( ierr /= 0 ) PRINT*,' pb in allloc f_h_bnd, ierr=', ierr 138 END IF 139 170 yd_h_col_vdf(:) =0. 171 yf_h_bnd(:) = 0. 140 172 !**************************************************************************************** 141 173 ! 2) … … 192 224 !**************************************************************************************** 193 225 194 CALL calc_coef(knon, yKcoefhq (:,:), ygamaq(:,:), delp(:,:), q(:,:), &195 yCcoef_Q (:,:), yDcoef_Q(:,:), yAcoef_Q, yBcoef_Q)226 CALL calc_coef(knon, yKcoefhq, ygamaq, delp, q, & 227 yCcoef_Q, yDcoef_Q, yAcoef_Q, yBcoef_Q) 196 228 197 229 !**************************************************************************************** … … 210 242 ENDDO 211 243 212 CALL calc_coef(knon, yKcoefhq (:,:), ygamah(:,:), delp(:,:), yh_old(:,:), &213 yCcoef_H (:,:), yDcoef_H(:,:), yAcoef_H, yBcoef_H)244 CALL calc_coef(knon, yKcoefhq, ygamah, delp, yh_old, & 245 yCcoef_H, yDcoef_H, yAcoef_H, yBcoef_H) 214 246 215 247 !**************************************************************************************** … … 282 314 ! 283 315 SUBROUTINE calc_coef(knon, Kcoef, gama, delp, X, Ccoef, Dcoef, Acoef, Bcoef) 316 !$gpum horizontal knon 284 317 ! 285 318 ! Calculate the coefficients C and D in : X(k) = C(k) + D(k)*X(k-1) … … 355 388 !!! 356 389 flux_q, flux_h, d_q, d_t) 390 !$gpum horizontal knon 391 357 392 ! 358 393 ! This routine calculates the flux and tendency of the specific humidity q and … … 392 427 REAL :: yAcoef_Q(knon), yBcoef_Q(knon), yAcoef_H(knon), yBcoef_H(knon) 393 428 REAL :: yKcoefhq(knon,klev) 394 REAL :: ygamaq( 1:knon,2:klev)395 REAL :: ygamah( 1:knon,2:klev)429 REAL :: ygamaq(knon,2:klev) 430 REAL :: ygamah(knon,2:klev) 396 431 REAL :: yh_old(knon,klev) 397 432 REAL :: yd_h_col_vdf(knon) 398 433 REAL :: yf_h_bnd(knon) 399 434 400 LOGICAL, SAVE :: last=.FALSE.401 !$OMP THREADPRIVATE(last)402 435 REAL, DIMENSION(knon,klev) :: h_new, q_new 403 436 REAL, DIMENSION(knon) :: psref … … 551 584 ENDDO 552 585 ENDDO 553 !**************************************************************************************** 554 ! Some deallocations 555 ! 556 !**************************************************************************************** 557 IF (last) THEN 558 DEALLOCATE(Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H,stat=ierr) 559 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Ccoef_Q, Dcoef_Q, Ccoef_H, Dcoef_H, ierr=', ierr 560 DEALLOCATE(Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H,stat=ierr) 561 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Acoef_Q, Bcoef_Q, Acoef_H, Bcoef_H, ierr=', ierr 562 DEALLOCATE(gamaq, gamah,stat=ierr) 563 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate gamaq, gamah, ierr=', ierr 564 DEALLOCATE(Kcoefhq,stat=ierr) 565 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate Kcoefhq, ierr=', ierr 566 DEALLOCATE(h_old, d_h_col_vdf, f_h_bnd, stat=ierr) 567 IF ( ierr /= 0 ) PRINT*,' pb in dealllocate h_old, d_h_col_vdf, f_h_bnd, ierr=', ierr 568 END IF 586 569 587 END SUBROUTINE climb_hq_up 570 588 ! -
LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/pbl_surface_mod.F90
r5876 r5878 109 109 USE flux_arp_mod_h 110 110 USE cdrag_mod, ONLY : cdrag_init 111 USE climb_hq_mod, ONLY : climb_hq_init 111 112 IMPLICIT NONE 112 113 … … 263 264 264 265 CALL cdrag_init 266 CALL climb_hq_init 265 267 266 268 END SUBROUTINE pbl_surface_init
Note: See TracChangeset
for help on using the changeset viewer.
