Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (3 months ago)
Author:
abarral
Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90

    r5136 r5158  
    450450        alpha_pcor(:) = 1.
    451451      else
    452         do l = 1, llm
     452        DO l = 1, llm
    453453          alpha_pcor(l) = (1. + tanh(((plim_guide_BL - presnivs(l)) / preff) / 0.05)) / 2.
    454454        enddo
    … …  
    993993      WRITE(*, *)trim(modname) // ' : check vertical level order'
    994994      WRITE(*, *)trim(modname) // ' LMDZ :'
    995       do l = 1, llm
     995      DO l = 1, llm
    996996        WRITE(*, *)trim(modname) // ' PL(', l, ')=', (ap(l) + ap(l + 1)) / 2. &
    997997                + psi(1, jjeu) * (bp(l) + bp(l + 1)) / 2.
    … …  
    10001000      SELECT CASE (guide_plevs)
    10011001      CASE (0)
    1002         do l = 1, nlevnc
     1002        DO l = 1, nlevnc
    10031003          WRITE(*, *)trim(modname) // ' PL(', l, ')=', plnc2(1, jjbu, l)
    10041004        enddo
    … …  
    10091009        ENDDO
    10101010      CASE (2)
    1011         do l = 1, nlevnc
     1011        DO l = 1, nlevnc
    10121012          WRITE(*, *)trim(modname) // ' PL(', l, ')=', pnat2(1, jjbu, l)
    10131013        enddo
    … …  
    10151015      WRITE(*, *)trim(modname) // ' invert ordering: invert_p=', invert_p
    10161016      IF (guide_u) THEN
    1017         do l = 1, nlevnc
     1017        DO l = 1, nlevnc
    10181018          WRITE(*, *)trim(modname) // ' U(', l, ')=', unat2(1, jjbu, l)
    10191019        enddo
    10201020      endif
    10211021      IF (guide_T) THEN
    1022         do l = 1, nlevnc
     1022        DO l = 1, nlevnc
    10231023          WRITE(*, *)trim(modname) // ' T(', l, ')=', tnat2(1, jjbu, l)
    10241024        enddo
    … …  
    10661066    !   calcul des pressions pour les grilles u et v
    10671067    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1068     do l = 1, llm
    1069       do j = jjbu, jjeu
    1070         do i = 1, iip1
     1068    DO l = 1, llm
     1069      DO j = jjbu, jjeu
     1070        DO i = 1, iip1
    10711071          pext(i, j, l) = pls(i, j, l) * aire(i, j)
    10721072        enddo
    … …  
    10831083    !$OMP BARRIER
    10841084    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1085     do l = 1, llm
    1086       do j = jjbu, jjeu
    1087         do i = 1, iip1
     1085    DO l = 1, llm
     1086      DO j = jjbu, jjeu
     1087        DO i = 1, iip1
    10881088          plunc(i, j, l) = pbarx(i, j, l) / aireu(i, j)
    10891089          plsnc(i, j, l) = pls(i, j, l)
    … …  
    10921092    enddo
    10931093    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1094     do l = 1, llm
    1095       do j = jjbv, jjev
    1096         do i = 1, iip1
     1094    DO l = 1, llm
     1095      DO j = jjbv, jjev
     1096        DO i = 1, iip1
    10971097          plvnc(i, j, l) = pbary(i, j, l) / airev(i, j)
    10981098        enddo
    … …  
    11061106    IF (guide_P) THEN
    11071107      !$OMP MASTER
    1108       do j = jjbu, jjeu
    1109         do i = 1, iim
     1108      DO j = jjbu, jjeu
     1109        DO i = 1, iim
    11101110          ij = (j - 1) * iip1 + i
    11111111          psgui1(ij) = psnat1(i, j)
    … …  
    11531153      ! Conversion en variables GCM
    11541154      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1155       do l = 1, llm
    1156         do j = jjbu, jjeu
     1155      DO l = 1, llm
     1156        DO j = jjbu, jjeu
    11571157          IF (guide_teta) THEN
    1158             do i = 1, iim
     1158            DO i = 1, iim
    11591159              ij = (j - 1) * iip1 + i
    11601160              tgui1(ij, l) = zu1(i, j, l)
    … …  
    11621162            enddo
    11631163          ELSE
    1164             do i = 1, iim
     1164            DO i = 1, iim
    11651165              ij = (j - 1) * iip1 + i
    11661166              tgui1(ij, l) = zu1(i, j, l) * cpp / pk(i, j, l)
    … …  
    11721172        enddo
    11731173        IF (pole_nord) THEN
    1174           do i = 1, iip1
     1174          DO i = 1, iip1
    11751175            tgui1(i, l) = tgui1(1, l)
    11761176            tgui2(i, l) = tgui2(1, l)
    … …  
    11781178        endif
    11791179        IF (pole_sud) THEN
    1180           do i = 1, iip1
     1180          DO i = 1, iip1
    11811181            tgui1(ip1jm + i, l) = tgui1(ip1jm + 1, l)
    11821182            tgui2(ip1jm + i, l) = tgui2(ip1jm + 1, l)
    … …  
    12231223      ! Hum.Rel si guide_hr, Hum.Spec. sinon.
    12241224      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1225       do l = 1, llm
    1226         do j = jjbu, jjeu
    1227           do i = 1, iim
     1225      DO l = 1, llm
     1226        DO j = jjbu, jjeu
     1227          DO i = 1, iim
    12281228            ij = (j - 1) * iip1 + i
    12291229            qgui1(ij, l) = zu1(i, j, l)
    … …  
    12341234        enddo
    12351235        IF (pole_nord) THEN
    1236           do i = 1, iip1
     1236          DO i = 1, iip1
    12371237            qgui1(i, l) = qgui1(1, l)
    12381238            qgui2(i, l) = qgui2(1, l)
    … …  
    12401240        endif
    12411241        IF (pole_sud) THEN
    1242           do i = 1, iip1
     1242          DO i = 1, iip1
    12431243            qgui1(ip1jm + i, l) = qgui1(ip1jm + 1, l)
    12441244            qgui2(ip1jm + i, l) = qgui2(ip1jm + 1, l)
    … …  
    12481248      IF (guide_hr) THEN
    12491249        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1250         do l = 1, llm
     1250        DO l = 1, llm
    12511251          CALL q_sat(iip1 * jjnu, teta(:, jjbu:jjeu, l) * pk(:, jjbu:jjeu, l) / cpp, &
    12521252                  plsnc(:, jjbu:jjeu, l), qsat(ijbu:ijeu, l))
    … …  
    13011301      ! Conversion en variables GCM
    13021302      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1303       do l = 1, llm
    1304         do j = jjbu, jjeu
    1305           do i = 1, iim
     1303      DO l = 1, llm
     1304        DO j = jjbu, jjeu
     1305          DO i = 1, iim
    13061306            ij = (j - 1) * iip1 + i
    13071307            ugui1(ij, l) = zu1(i, j, l) * cu(i, j)
    … …  
    13121312        enddo
    13131313        IF (pole_nord) THEN
    1314           do i = 1, iip1
     1314          DO i = 1, iip1
    13151315            ugui1(i, l) = 0.
    13161316            ugui2(i, l) = 0.
    … …  
    13181318        endif
    13191319        IF (pole_sud) THEN
    1320           do i = 1, iip1
     1320          DO i = 1, iip1
    13211321            ugui1(ip1jm + i, l) = 0.
    13221322            ugui2(ip1jm + i, l) = 0.
    … …  
    13761376      ! Conversion en variables GCM
    13771377      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1378       do l = 1, llm
    1379         do j = jjbv, jjev
    1380           do i = 1, iim
     1378      DO l = 1, llm
     1379        DO j = jjbv, jjev
     1380          DO i = 1, iim
    13811381            ij = (j - 1) * iip1 + i
    13821382            vgui1(ij, l) = zv1(i, j, l) * cv(i, j)
    … …  
    14341434      !-----------------------------------------------------------------------
    14351435      IF (guide_reg) THEN
    1436         do j = jjb, jje
    1437           do i = 1, pim
     1436        DO j = jjb, jje
     1437          DO i = 1, pim
    14381438            IF (typ==2) THEN
    14391439              zlat = rlatu(j) * 180. / pi
    … …  
    14591459      !-----------------------------------------------------------------------
    14601460      !Calcul de l'aire des mailles
    1461       do j = 2, jjm
    1462         do i = 2, iip1
     1461      DO j = 2, jjm
     1462        DO i = 2, iip1
    14631463          zdx(i, j) = 0.5 * (cu(i - 1, j) + cu(i, j)) / cos(rlatu(j))
    14641464        enddo
    14651465        zdx(1, j) = zdx(iip1, j)
    14661466      enddo
    1467       do j = 2, jjm
    1468         do i = 1, iip1
     1467      DO j = 2, jjm
     1468        DO i = 1, iip1
    14691469          zdy(i, j) = 0.5 * (cv(i, j - 1) + cv(i, j))
    14701470        enddo
    14711471      enddo
    1472       do i = 1, iip1
     1472      DO i = 1, iip1
    14731473        zdx(i, 1) = zdx(i, 2)
    14741474        zdx(i, jjp1) = zdx(i, jjm)
    … …  
    14761476        zdy(i, jjp1) = zdy(i, jjm)
    14771477      enddo
    1478       do j = 1, jjp1
    1479         do i = 1, iip1
     1478      DO j = 1, jjp1
     1479        DO i = 1, iip1
    14801480          dxdys(i, j) = sqrt(zdx(i, j) * zdx(i, j) + zdy(i, j) * zdy(i, j))
    14811481        enddo
    14821482      enddo
    14831483      IF (typ==2) THEN
    1484         do j = 1, jjp1
    1485           do i = 1, iim
     1484        DO j = 1, jjp1
     1485          DO i = 1, iim
    14861486            dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
    14871487          enddo
    … …  
    14901490      ENDIF
    14911491      IF (typ==3) THEN
    1492         do j = 1, jjm
    1493           do i = 1, iip1
     1492        DO j = 1, jjm
     1493          DO i = 1, iip1
    14941494            dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
    14951495          enddo
    … …  
    15051505        ! dxdy maximale de la maille
    15061506        dxdy_max = 0.
    1507         do j = 1, jjp1
    1508           do i = 1, iip1
     1507        DO j = 1, jjp1
     1508          DO i = 1, iip1
    15091509            dxdy_max = max(dxdy_max, dxdys(i, j))
    15101510          enddo
    … …  
    15301530      ENDIF !first
    15311531
    1532       do j = jjb, jje
    1533         do i = 1, pim
     1532      DO j = jjb, jje
     1533        DO i = 1, pim
    15341534          IF (typ==1) THEN
    15351535            dxdy_ = dxdys(i, j)
    … …  
    23602360    REAL zz
    23612361
    2362     do l = 1, nl
    2363       do i = 2, iim - 1
     2362    DO l = 1, nl
     2363      DO i = 2, iim - 1
    23642364        IF(abs(x(i, l))>1.e10) THEN
    23652365          zz = 0.5 * (x(i - 1, l) + x(i + 1, l))
Note: See TracChangeset for help on using the changeset viewer.