--- trunk/dyn3d/fyhyp.f 2014/04/25 14:58:31 97 +++ trunk/dyn3d/fyhyp.f 2015/01/28 16:10:02 121 @@ -1,46 +1,34 @@ module fyhyp_m - IMPLICIT NONE + IMPLICIT NONE contains - SUBROUTINE fyhyp(yzoomdeg, grossism, dzooma, tau, rrlatu, yyprimu, rrlatv, & - yyprimv, rlatu2, yprimu2, rlatu1, yprimu1, champmin, champmax) + SUBROUTINE fyhyp(rlatu, yyprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1) ! From LMDZ4/libf/dyn3d/fyhyp.F, version 1.2, 2005/06/03 09:11:32 ! Author: P. Le Van, from analysis by R. Sadourny ! Calcule les latitudes et dérivées dans la grille du GCM pour une - ! fonction f(y) à tangente hyperbolique. + ! fonction f(y) à dérivée tangente hyperbolique. - ! Nota bene : il vaut mieux avoir grossism * dzoom < pi / 2 (rad), - ! en latitude. + ! Il vaut mieux avoir : grossismy * dzoom < pi / 2 + use coefpoly_m, only: coefpoly USE dimens_m, only: jjm - USE paramet_m, only: JJP1 + use serre, only: clat, grossismy, dzoomy, tauy - REAL, intent(in):: yzoomdeg - - REAL, intent(in):: grossism - ! grossissement (= 2 si 2 fois, = 3 si 3 fois, etc.) - - REAL, intent(in):: dzooma - - REAL, intent(in):: tau - ! raideur de la transition de l'intérieur à l'extérieur du zoom - - ! arguments de sortie - - REAL rrlatu(jjp1), yyprimu(jjp1), rrlatv(jjm), yyprimv(jjm) - real rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm) - DOUBLE PRECISION champmin, champmax + REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1) + REAL, intent(out):: rlatv(jjm) + real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm) ! Local: + DOUBLE PRECISION champmin, champmax INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax REAL dzoom ! distance totale de la zone du zoom (en radians) - DOUBLE PRECISION ylat(jjp1), yprim(jjp1) + DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1) DOUBLE PRECISION yuv DOUBLE PRECISION, save:: yt(0:nmax2) DOUBLE PRECISION fhyp(0:nmax2), beta @@ -48,7 +36,7 @@ DOUBLE PRECISION fxm(0:nmax2) DOUBLE PRECISION, save:: yf(0:nmax2) DOUBLE PRECISION yypr(0:nmax2) - DOUBLE PRECISION yvrai(jjp1), yprimm(jjp1), ylatt(jjp1) + DOUBLE PRECISION yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1) DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin DOUBLE PRECISION yfi, yf1, ffdy @@ -66,24 +54,16 @@ !------------------------------------------------------------------- + print *, "Call sequence information: fyhyp" + pi = 2.*asin(1.) pis2 = pi/2. pisjm = pi/real(jjm) epsilon = 1e-3 - y0 = yzoomdeg*pi/180. - - IF (dzooma<1.) THEN - dzoom = dzooma*pi - ELSE IF (dzooma<12.) THEN - print *, "Le paramètre dzoomy pour fyhyp est trop petit. L'augmenter " & - // "et relancer." - STOP 1 - ELSE - dzoom = dzooma*pi/180. - END IF - - print *, 'yzoom(rad), grossism, tau, dzoom (rad):' - print *, y0, grossism, tau, dzoom + y0 = clat*pi/180. + dzoom = dzoomy*pi + print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):' + print *, y0, grossismy, tauy, dzoom DO i = 0, nmax2 yt(i) = -pis2 + real(i)*pi/nmax2 @@ -99,10 +79,10 @@ DO i = 0, nmax2 IF (yt(i)y0) THEN - fa(i) = tau*(y0-yt(i) + dzoom/2.) + fa(i) = tauy*(y0-yt(i) + dzoom/2.) fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0) END IF @@ -125,10 +105,10 @@ DO i = 1, nmax2 ymoy = 0.5*(yt(i-1) + yt(i)) IF (ymoyy0) THEN - fa(i) = tau*(y0-ymoy + dzoom/2.) + fa(i) = tauy*(y0-ymoy + dzoom/2.) fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0) END IF @@ -144,9 +124,9 @@ ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1)) END DO - beta = (grossism*ffdy-pi)/(ffdy-pi) + beta = (grossismy*ffdy-pi)/(ffdy-pi) - IF (2. * beta - grossism <= 0.) THEN + IF (2. * beta - grossismy <= 0.) THEN print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' & // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' & // 'dzoomy et relancer.' @@ -156,14 +136,14 @@ ! calcul de Ytprim DO i = 0, nmax2 - ytprim(i) = beta + (grossism-beta)*fhyp(i) + ytprim(i) = beta + (grossismy-beta)*fhyp(i) END DO ! Calcul de Yf yf(0) = -pis2 DO i = 1, nmax2 - yypr(i) = beta + (grossism-beta)*fxm(i) + yypr(i) = beta + (grossismy-beta)*fxm(i) END DO DO i = 1, nmax2 @@ -245,7 +225,7 @@ IF (ik==1) THEN ypn = pis2 - DO j = jlat, 1, -1 + DO j = jjm + 1, 1, -1 IF (yvrai(j)<=ypn) exit END DO @@ -279,22 +259,21 @@ END DO IF (ik==1) THEN - DO j = 1, jlat - rrlatu(j) = ylat(j) + DO j = 1, jjm + 1 + rlatu(j) = ylat(j) yyprimu(j) = yprim(j) END DO ELSE IF (ik==2) THEN - DO j = 1, jlat - rrlatv(j) = ylat(j) - yyprimv(j) = yprim(j) + DO j = 1, jjm + rlatv(j) = ylat(j) END DO ELSE IF (ik==3) THEN - DO j = 1, jlat + DO j = 1, jjm rlatu2(j) = ylat(j) yprimu2(j) = yprim(j) END DO ELSE IF (ik==4) THEN - DO j = 1, jlat + DO j = 1, jjm rlatu1(j) = ylat(j) yprimu1(j) = yprim(j) END DO @@ -302,7 +281,7 @@ END DO loop_ik DO j = 1, jjm - ylat(j) = rrlatu(j) - rrlatu(j + 1) + ylat(j) = rlatu(j) - rlatu(j + 1) END DO champmin = 1e12 champmax = -1e12 @@ -313,6 +292,46 @@ champmin = champmin*180./pi champmax = champmax*180./pi + DO j = 1, jjm + IF (rlatu1(j) <= rlatu2(j)) THEN + print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j + STOP 13 + ENDIF + + IF (rlatu2(j) <= rlatu(j+1)) THEN + print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j + STOP 14 + ENDIF + + IF (rlatu(j) <= rlatu1(j)) THEN + print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j + STOP 15 + ENDIF + + IF (rlatv(j) <= rlatu2(j)) THEN + print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j + STOP 16 + ENDIF + + IF (rlatv(j) >= rlatu1(j)) THEN + print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j + STOP 17 + ENDIF + + IF (rlatv(j) >= rlatu(j)) THEN + print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j + STOP 18 + ENDIF + ENDDO + + print *, 'Latitudes' + print 3, champmin, champmax + +3 Format(1x, ' Au centre du zoom, la longueur de la maille est', & + ' d environ ', f0.2, ' degres ', /, & + ' alors que la maille en dehors de la zone du zoom est ', & + "d'environ ", f0.2, ' degres ') + END SUBROUTINE fyhyp end module fyhyp_m