/[lmdze]/trunk/libf/dyn3d/inigeom.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/inigeom.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 7 by guez, Mon Mar 31 12:24:17 2008 UTC revision 22 by guez, Fri Jul 31 15:18:47 2009 UTC
# Line 13  SUBROUTINE inigeom Line 13  SUBROUTINE inigeom
13    ! sinusoïdale.    ! sinusoïdale.
14    
15    
16    USE dimens_m    USE dimens_m, ONLY : iim, jjm
17    USE paramet_m    USE paramet_m, ONLY : iip1, jjp1
18    USE comconst    USE comconst, ONLY : g, omeg, pi, rad
19    USE comdissnew    USE comdissnew, ONLY : coefdis, nitergdiv, nitergrot, niterh
20    USE logic    USE logic, ONLY : fxyhypb, ysinus
21    USE comgeom    USE comgeom, ONLY : aireij1_2d, aireij2_2d, aireij3_2d, aireij4_2d, &
22    USE serre         airesurg_2d, aireu_2d, airev_2d, aire_2d, airuscv2_2d, airvscu2_2d, &
23    IMPLICIT NONE         aiuscv2gam_2d, aivscu2gam_2d, alpha1p2_2d, alpha1p4_2d, alpha1_2d, &
24           alpha2p3_2d, alpha2_2d, alpha3p4_2d, alpha3_2d, alpha4_2d, apoln, &
25           apols, constang_2d, cuscvugam_2d, cusurcvu_2d, cuvscvgam1_2d, &
26           cuvscvgam2_2d, cuvsurcv_2d, cu_2d, cvscuvgam_2d, cvsurcuv_2d, &
27           cvuscugam1_2d, cvuscugam2_2d, cvusurcu_2d, cv_2d, fext_2d, rlatu, &
28           rlatv, rlonu, rlonv, unsairez_2d, unsaire_2d, unsairz_gam_2d, &
29           unsair_gam1_2d, unsair_gam2_2d, unsapolnga1, unsapolnga2, unsapolsga1, &
30           unsapolsga2, unscu2_2d, unscv2_2d, xprimu, xprimv
31      USE serre, ONLY : alphax, alphay, clat, clon, dzoomx, dzoomy, grossismx, &
32           grossismy, pxo, pyo, taux, tauy, transx, transy
33    
34      IMPLICIT NONE
35    
   !------------------------------------------------------------------  
36    !   ....  Variables  locales   ....    !   ....  Variables  locales   ....
37    
38    INTEGER i, j, itmax, itmay, iter    INTEGER i, j, itmax, itmay, iter
# Line 213  SUBROUTINE inigeom Line 222  SUBROUTINE inigeom
222          eps = .1E-7          eps = .1E-7
223    
224          xo1 = 0.          xo1 = 0.
225          DO  iter = 1, itmax          DO iter = 1, itmax
226             x1 = xo1             x1 = xo1
227             f = x1 + alphax*sin(x1-pxo)             f = x1 + alphax*sin(x1-pxo)
228             df = 1. + alphax*cos(x1-pxo)             df = 1. + alphax*cos(x1-pxo)
229             x1 = x1 - f/df             x1 = x1 - f/df
230             xdm = abs(x1-xo1)             xdm = abs(x1-xo1)
231             IF (xdm<=eps) exit             IF (xdm<=eps) EXIT
232             xo1 = x1             xo1 = x1
233          end DO          END DO
234    
235          transx = xo1          transx = xo1
236    
# Line 235  SUBROUTINE inigeom Line 244  SUBROUTINE inigeom
244             df = 1. + alphay*cos(y1-pyo)             df = 1. + alphay*cos(y1-pyo)
245             y1 = y1 - f/df             y1 = y1 - f/df
246             ydm = abs(y1-yo1)             ydm = abs(y1-yo1)
247             IF (ydm<=eps) exit             IF (ydm<=eps) EXIT
248             yo1 = y1             yo1 = y1
249          end DO          END DO
250    
251          transy = yo1          transy = yo1
252    
# Line 353  SUBROUTINE inigeom Line 362  SUBROUTINE inigeom
362             cuij3(i,1) = radclatm*xprm             cuij3(i,1) = radclatm*xprm
363             cvij2(i,1) = 0.5*rad*yprm             cvij2(i,1) = 0.5*rad*yprm
364             cvij3(i,1) = cvij2(i,1)             cvij3(i,1) = cvij2(i,1)
365          end DO          END DO
366    
367          DO i = 1, iim          DO i = 1, iim
368             aireij1_2d(i,1) = 0.             aireij1_2d(i,1) = 0.
# Line 384  SUBROUTINE inigeom Line 393  SUBROUTINE inigeom
393             cuij4(i,jjp1) = radclatp*xprm             cuij4(i,jjp1) = radclatp*xprm
394             cvij1(i,jjp1) = 0.5*rad*yprp             cvij1(i,jjp1) = 0.5*rad*yprp
395             cvij4(i,jjp1) = cvij1(i,jjp1)             cvij4(i,jjp1) = cvij1(i,jjp1)
396          end DO          END DO
397    
398          DO i = 1, iim          DO i = 1, iim
399             aireij2_2d(i,jjp1) = 0.             aireij2_2d(i,jjp1) = 0.
# Line 432  SUBROUTINE inigeom Line 441  SUBROUTINE inigeom
441             cvij2(i,j) = 0.5*rad*yprm             cvij2(i,j) = 0.5*rad*yprm
442             cvij3(i,j) = cvij2(i,j)             cvij3(i,j) = cvij2(i,j)
443             cvij4(i,j) = cvij1(i,j)             cvij4(i,j) = cvij1(i,j)
444          end DO          END DO
445    
446       END IF       END IF
447    
# Line 451  SUBROUTINE inigeom Line 460  SUBROUTINE inigeom
460       aireij3_2d(iip1,j) = aireij3_2d(1,j)       aireij3_2d(iip1,j) = aireij3_2d(1,j)
461       aireij4_2d(iip1,j) = aireij4_2d(1,j)       aireij4_2d(iip1,j) = aireij4_2d(1,j)
462    
463    end DO    END DO
464    
465    !    ..............................................................    !    ..............................................................
466    
# Line 467  SUBROUTINE inigeom Line 476  SUBROUTINE inigeom
476          alpha1p4_2d(i,j) = alpha1_2d(i,j) + alpha4_2d(i,j)          alpha1p4_2d(i,j) = alpha1_2d(i,j) + alpha4_2d(i,j)
477          alpha2p3_2d(i,j) = alpha2_2d(i,j) + alpha3_2d(i,j)          alpha2p3_2d(i,j) = alpha2_2d(i,j) + alpha3_2d(i,j)
478          alpha3p4_2d(i,j) = alpha3_2d(i,j) + alpha4_2d(i,j)          alpha3p4_2d(i,j) = alpha3_2d(i,j) + alpha4_2d(i,j)
479       end DO       END DO
480    
481    
482       aire_2d(iip1,j) = aire_2d(1,j)       aire_2d(iip1,j) = aire_2d(1,j)
# Line 479  SUBROUTINE inigeom Line 488  SUBROUTINE inigeom
488       alpha1p4_2d(iip1,j) = alpha1p4_2d(1,j)       alpha1p4_2d(iip1,j) = alpha1p4_2d(1,j)
489       alpha2p3_2d(iip1,j) = alpha2p3_2d(1,j)       alpha2p3_2d(iip1,j) = alpha2p3_2d(1,j)
490       alpha3p4_2d(iip1,j) = alpha3p4_2d(1,j)       alpha3p4_2d(iip1,j) = alpha3p4_2d(1,j)
491    end DO    END DO
492    
493    
494    DO j = 1, jjp1    DO j = 1, jjp1
# Line 490  SUBROUTINE inigeom Line 499  SUBROUTINE inigeom
499          unsair_gam1_2d(i,j) = unsaire_2d(i,j)**(-gamdi_gdiv)          unsair_gam1_2d(i,j) = unsaire_2d(i,j)**(-gamdi_gdiv)
500          unsair_gam2_2d(i,j) = unsaire_2d(i,j)**(-gamdi_h)          unsair_gam2_2d(i,j) = unsaire_2d(i,j)**(-gamdi_h)
501          airesurg_2d(i,j) = aire_2d(i,j)/g          airesurg_2d(i,j) = aire_2d(i,j)/g
502       end DO       END DO
503       aireu_2d(iip1,j) = aireu_2d(1,j)       aireu_2d(iip1,j) = aireu_2d(1,j)
504       unsaire_2d(iip1,j) = unsaire_2d(1,j)       unsaire_2d(iip1,j) = unsaire_2d(1,j)
505       unsair_gam1_2d(iip1,j) = unsair_gam1_2d(1,j)       unsair_gam1_2d(iip1,j) = unsair_gam1_2d(1,j)
506       unsair_gam2_2d(iip1,j) = unsair_gam2_2d(1,j)       unsair_gam2_2d(iip1,j) = unsair_gam2_2d(1,j)
507       airesurg_2d(iip1,j) = airesurg_2d(1,j)       airesurg_2d(iip1,j) = airesurg_2d(1,j)
508    end DO    END DO
509    
510    
511    DO j = 1, jjm    DO j = 1, jjm
# Line 517  SUBROUTINE inigeom Line 526  SUBROUTINE inigeom
526       fext_2d(iip1,j) = fext_2d(1,j)       fext_2d(iip1,j) = fext_2d(1,j)
527       unsairz_gam_2d(iip1,j) = unsairz_gam_2d(1,j)       unsairz_gam_2d(iip1,j) = unsairz_gam_2d(1,j)
528    
529    end DO    END DO
530    
531    
532    !    .....      Calcul  des elongations cu_2d,cv_2d, cvu     .........    !    .....      Calcul  des elongations cu_2d,cv_2d, cvu     .........
Legend:
Removed from v.7  
changed lines
  Added in v.22
  ViewVC Help
Powered by ViewVC 1.1.21