Ignore:
Timestamp:
Jul 25, 2024, 5:47:25 PM (4 months ago)
Author:
abarral
Message:

Correct bug in vlspltqs_loc.f90 from r2270 where we call SSUM with incorrect arguments.
Merge the three different versions of abort_gcm into one
Fix seq, para 3D compilation broken from r5107 onwards
(lint) usual + Remove uneeded fixed-form continuations

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

    r5119 r5128  
    11MODULE lmdz_1dutils
    22  IMPLICIT NONE; PRIVATE
    3   PUBLIC fq_sat, conf_unicol, dyn1deta0, dyn1dredem, gr_fi_dyn, abort_gcm, gr_dyn_fi, &
     3  PUBLIC fq_sat, conf_unicol, dyn1deta0, dyn1dredem, &
    44          disvert0, advect_vert, advect_va, lstendh, nudge_rht_init, nudge_uv_init, &
    55          nudge_rht, nudge_uv, interp2_case_vertical
    … …  
    981981
    982982
    983   SUBROUTINE gr_fi_dyn(nfield, ngrid, im, jm, pfi, pdyn)
    984     USE lmdz_ssum_scopy, ONLY: scopy
    985 
    986     IMPLICIT NONE
    987     !=======================================================================
    988     !   passage d'un champ de la grille scalaire a la grille physique
    989     !=======================================================================
    990 
    991     !-----------------------------------------------------------------------
    992     !   declarations:
    993     !   -------------
    994 
    995     INTEGER im, jm, ngrid, nfield
    996     REAL pdyn(im, jm, nfield)
    997     REAL pfi(ngrid, nfield)
    998 
    999     INTEGER i, j, ifield, ig
    1000 
    1001     !-----------------------------------------------------------------------
    1002     !   calcul:
    1003     !   -------
    1004 
    1005     DO ifield = 1, nfield
    1006       !   traitement des poles
    1007       DO i = 1, im
    1008         pdyn(i, 1, ifield) = pfi(1, ifield)
    1009         pdyn(i, jm, ifield) = pfi(ngrid, ifield)
    1010       ENDDO
    1011 
    1012       !   traitement des point normaux
    1013       DO j = 2, jm - 1
    1014         ig = 2 + (j - 2) * (im - 1)
    1015         CALL SCOPY(im - 1, pfi(ig, ifield), 1, pdyn(1, j, ifield), 1)
    1016         pdyn(im, j, ifield) = pdyn(1, j, ifield)
    1017       ENDDO
    1018     ENDDO
    1019 
    1020   END SUBROUTINE gr_fi_dyn
    1021 
    1022 
    1023   SUBROUTINE abort_gcm(modname, message, ierr)
    1024     USE IOIPSL
    1025 
    1026     ! Stops the simulation cleanly, closing files and printing various
    1027     ! comments
    1028 
    1029     !  Input: modname = name of calling program
    1030     !         message = stuff to print
    1031     !         ierr    = severity of situation ( = 0 normal )
    1032 
    1033     CHARACTER(LEN = *) modname
    1034     INTEGER ierr
    1035     CHARACTER(LEN = *) message
    1036 
    1037     WRITE(*, *) 'in abort_gcm'
    1038     CALL histclo
    1039     !     CALL histclo(2)
    1040     !     CALL histclo(3)
    1041     !     CALL histclo(4)
    1042     !     CALL histclo(5)
    1043     WRITE(*, *) 'out of histclo'
    1044     WRITE(*, *) 'Stopping in ', modname
    1045     WRITE(*, *) 'Reason = ', message
    1046     CALL getin_dump
    1047 
    1048     IF (ierr == 0) THEN
    1049       WRITE(*, *) 'Everything is cool'
    1050     else
    1051       WRITE(*, *) 'Houston, we have a problem ', ierr
    1052     endif
    1053     STOP
    1054   END SUBROUTINE abort_gcm
    1055 
    1056 
    1057   SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi)
    1058     IMPLICIT NONE
    1059     !=======================================================================
    1060     !   passage d'un champ de la grille scalaire a la grille physique
    1061     !=======================================================================
    1062 
    1063     !-----------------------------------------------------------------------
    1064     !   declarations:
    1065     !   -------------
    1066 
    1067     INTEGER im, jm, ngrid, nfield
    1068     REAL pdyn(im, jm, nfield)
    1069     REAL pfi(ngrid, nfield)
    1070 
    1071     INTEGER j, ifield, ig
    1072 
    1073     !-----------------------------------------------------------------------
    1074     !   calcul:
    1075     !   -------
    1076 
    1077     IF(ngrid/=2 + (jm - 2) * (im - 1).AND.ngrid/=1)                          &
    1078             &    STOP 'probleme de dim'
    1079     !   traitement des poles
    1080     CALL SCOPY(nfield, pdyn, im * jm, pfi, ngrid)
    1081     CALL SCOPY(nfield, pdyn(1, jm, 1), im * jm, pfi(ngrid, 1), ngrid)
    1082 
    1083     !   traitement des point normaux
    1084     DO ifield = 1, nfield
    1085       DO j = 2, jm - 1
    1086         ig = 2 + (j - 2) * (im - 1)
    1087         CALL SCOPY(im - 1, pdyn(1, j, ifield), 1, pfi(ig, ifield), 1)
    1088       ENDDO
    1089     ENDDO
    1090   END SUBROUTINE gr_dyn_fi
    1091 
    1092 
    1093983  SUBROUTINE disvert0(pa, preff, ap, bp, dpres, presnivs, nivsigs, nivsig)
    1094984
    … …  
    18521742
    18531743END MODULE lmdz_1dutils
     1744
     1745SUBROUTINE gr_fi_dyn(nfield, ngrid, im, jm, pfi, pdyn)
     1746  USE lmdz_ssum_scopy, ONLY: scopy
     1747
     1748  IMPLICIT NONE
     1749  !=======================================================================
     1750  !   passage d'un champ de la grille scalaire a la grille physique
     1751  !=======================================================================
     1752
     1753  !-----------------------------------------------------------------------
     1754  !   declarations:
     1755  !   -------------
     1756
     1757  INTEGER im, jm, ngrid, nfield
     1758  REAL pdyn(im, jm, nfield)
     1759  REAL pfi(ngrid, nfield)
     1760
     1761  INTEGER i, j, ifield, ig
     1762
     1763  !-----------------------------------------------------------------------
     1764  !   calcul:
     1765  !   -------
     1766
     1767  DO ifield = 1, nfield
     1768    !   traitement des poles
     1769    DO i = 1, im
     1770      pdyn(i, 1, ifield) = pfi(1, ifield)
     1771      pdyn(i, jm, ifield) = pfi(ngrid, ifield)
     1772    ENDDO
     1773
     1774    !   traitement des point normaux
     1775    DO j = 2, jm - 1
     1776      ig = 2 + (j - 2) * (im - 1)
     1777      CALL SCOPY(im - 1, pfi(ig, ifield), 1, pdyn(1, j, ifield), 1)
     1778      pdyn(im, j, ifield) = pdyn(1, j, ifield)
     1779    ENDDO
     1780  ENDDO
     1781
     1782END SUBROUTINE gr_fi_dyn
     1783
     1784SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi)
     1785  USE lmdz_ssum_scopy, ONLY: scopy
     1786
     1787  IMPLICIT NONE
     1788  !=======================================================================
     1789  !   passage d'un champ de la grille scalaire a la grille physique
     1790  !=======================================================================
     1791
     1792  !-----------------------------------------------------------------------
     1793  !   declarations:
     1794  !   -------------
     1795
     1796  INTEGER im, jm, ngrid, nfield
     1797  REAL pdyn(im, jm, nfield)
     1798  REAL pfi(ngrid, nfield)
     1799
     1800  INTEGER j, ifield, ig
     1801
     1802  !-----------------------------------------------------------------------
     1803  !   calcul:
     1804  !   -------
     1805
     1806  IF(ngrid/=2 + (jm - 2) * (im - 1).AND.ngrid/=1)                          &
     1807          &    STOP 'probleme de dim'
     1808  !   traitement des poles
     1809  CALL SCOPY(nfield, pdyn, im * jm, pfi, ngrid)
     1810  CALL SCOPY(nfield, pdyn(1, jm, 1), im * jm, pfi(ngrid, 1), ngrid)
     1811
     1812  !   traitement des point normaux
     1813  DO ifield = 1, nfield
     1814    DO j = 2, jm - 1
     1815      ig = 2 + (j - 2) * (im - 1)
     1816      CALL SCOPY(im - 1, pdyn(1, j, ifield), 1, pfi(ig, ifield), 1)
     1817    ENDDO
     1818  ENDDO
     1819END SUBROUTINE gr_dyn_fi
Note: See TracChangeset for help on using the changeset viewer.