Changeset 170


Ignore:
Timestamp:
09/10/13 12:04:33 (11 years ago)
Author:
dubos
Message:

Activated call to physics - Held & Suarez test case seems to work now

Location:
codes/icosagcm/trunk
Files:
4 added
4 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/etat0.f90

    r168 r170  
    4949    CASE ('academic') 
    5050       CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    51     CASE ('heldsz') 
    52         print*,"heldsz test case" 
     51    CASE ('held_suarez') 
     52       PRINT *,"Held & Suarez (1994) test case" 
    5353       CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    5454    CASE ('dcmip1') 

  • codes/icosagcm/trunk/src/etat0_heldsz.f90

    r149 r170  
    1     MODULE etat0_heldsz_mod 
    2          USE icosa 
    3       IMPLICIT NONE 
    4   REAL(rstd),ALLOCATABLE::knewt_t(:),kfrict(:) 
    5   REAL(rstd)::knewt_g 
    6   TYPE(t_field),POINTER :: f_tetarappel(:) 
    7   TYPE(t_field),POINTER :: f_clat(:) 
    8  
     1MODULE etat0_heldsz_mod 
     2  USE icosa 
     3  IMPLICIT NONE 
     4  PRIVATE 
     5 
     6  TYPE(t_field),POINTER :: f_theta_eq(:) 
     7  TYPE(t_field),POINTER :: f_theta(:) 
     8  TYPE(t_field),POINTER :: f_clat(:) ! FIXME, duplication 
     9 
     10  REAL(rstd),ALLOCATABLE :: knewt_t(:),kfrict(:) 
     11 
     12  LOGICAL, SAVE :: done=.FALSE. 
     13 
     14  REAL(rstd) :: teta0,ttp,delt_y,delt_z,eps 
     15  REAL(rstd) :: knewt_g, k_f,k_c_a,k_c_s 
     16 
     17  PUBLIC :: etat0, held_suarez 
     18   
    919CONTAINS 
    10    
     20 
    1121  SUBROUTINE test_etat0_heldsz 
    12   USE icosa 
    13   USE kinetic_mod 
    14   IMPLICIT NONE 
     22    USE icosa 
     23    USE kinetic_mod 
     24    IMPLICIT NONE 
    1525    TYPE(t_field),POINTER :: f_ps(:) 
    1626    TYPE(t_field),POINTER :: f_phis(:) 
    … …  
    1929    TYPE(t_field),POINTER :: f_q(:) 
    2030    TYPE(t_field),POINTER :: f_Ki(:) 
    21    
     31 
    2232    REAL(rstd),POINTER :: Ki(:,:) 
    2333    INTEGER :: ind 
    24      
    25      
     34 
    2635    CALL allocate_field(f_ps,field_t,type_real) 
    2736    CALL allocate_field(f_phis,field_t,type_real) 
    … …  
    2938    CALL allocate_field(f_u,field_u,type_real,llm) 
    3039    CALL allocate_field(f_Ki,field_t,type_real,llm) 
    31      
     40 
    3241    CALL etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    3342    CALL kinetic(f_u,f_Ki) 
    … …  
    3645    CALL writefield('theta',f_theta_rhodz) 
    3746  END SUBROUTINE test_etat0_heldsz 
    38     
    39      
     47 
    4048  SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 
    41   USE icosa 
    42   IMPLICIT NONE 
     49    USE icosa 
     50    USE theta2theta_rhodz_mod 
     51    IMPLICIT NONE 
    4352    TYPE(t_field),POINTER :: f_ps(:) 
    4453    TYPE(t_field),POINTER :: f_phis(:) 
    … …  
    4655    TYPE(t_field),POINTER :: f_u(:) 
    4756    TYPE(t_field),POINTER :: f_q(:) 
    48    
     57 
    4958    REAL(rstd),POINTER :: ps(:) 
    5059    REAL(rstd),POINTER :: phis(:) 
    … …  
    5261    REAL(rstd),POINTER :: u(:,:) 
    5362    REAL(rstd),POINTER :: q(:,:,:) 
     63    REAL(rstd),POINTER :: clat(:)  
     64    REAL(rstd),POINTER :: theta_eq(:,:)  
     65    REAL(rstd),POINTER :: theta(:,:)  
     66 
    5467    INTEGER :: ind 
    55     REAL(rstd),POINTER::clat(:)  
    56     REAL(rstd),POINTER::tetarappel(:,:)  
    57      
    58     CALL allocate_field(f_tetarappel,field_t,type_real,llm) 
    59     CALL allocate_field(f_clat,field_t,type_real) 
    60     ALLOCATE(knewt_t(llm)); ALLOCATE( kfrict(llm))  
    61  
     68 
     69    CALL Init_Teq 
    6270    DO ind=1,ndomain 
    63       CALL swap_dimensions(ind) 
    64       CALL swap_geometry(ind) 
    65       ps=f_ps(ind) 
    66       phis=f_phis(ind) 
    67       theta_rhodz=f_theta_rhodz(ind) 
    68       tetarappel=f_tetarappel(ind)  
    69       u=f_u(ind) 
    70       q=f_q(ind) 
    71       q=1e2 
    72       clat=f_clat(ind)  
    73       CALL compute_etat0_heldsz(ps, phis, theta_rhodz, u,clat,tetarappel) 
     71       CALL swap_dimensions(ind) 
     72       CALL swap_geometry(ind) 
     73 
     74       theta_eq=f_theta_eq(ind)  
     75       clat=f_clat(ind)  
     76       CALL compute_Teq(clat,theta_eq) ! FIXME : already done by Init_Teq 
     77 
     78       ps=f_ps(ind) 
     79       phis=f_phis(ind) 
     80       u=f_u(ind) 
     81       ps(:)=1e5 
     82       phis(:)=0. 
     83       u(:,:)=0 
     84 
     85       theta_rhodz=f_theta_rhodz(ind) 
     86       theta=f_theta(ind) 
     87       CALL compute_etat0_heldsz(theta_eq,theta) 
     88       CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 
     89       q=f_q(ind) 
     90       q(:,:,:)=1e2 
    7491    ENDDO 
    7592  END SUBROUTINE etat0 
    7693 
    77   SUBROUTINE compute_etat0_heldsz(ps, phis, theta_rhodz, u,clat,tetarappel) 
    78   USE icosa 
    79   USE disvert_mod 
    80   USE pression_mod 
    81   USE exner_mod 
    82   USE geopotential_mod 
    83   USE theta2theta_rhodz_mod 
    84   IMPLICIT NONE   
    85   REAL(rstd),INTENT(OUT) :: ps(iim*jjm) 
    86   REAL(rstd),INTENT(OUT) :: phis(iim*jjm) 
    87   REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) 
    88   REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm) 
    89   REAL(rstd),INTENT(OUT) :: clat(iim*jjm) 
    90   REAL(rstd),INTENT(OUT) :: tetarappel(iim*jjm,llm)  
    91    
    92   INTEGER :: i,j,l,ij 
    93   REAL(rstd) :: r 
    94   REAL(rstd) :: theta(iim*jjm,llm) 
    95   REAL(rstd) :: zsig 
    96   INTEGER    :: lsup 
    97   REAL(rstd) :: ddsin 
    98   REAL(rstd) :: lon,lat 
    99   REAL(rstd) :: p(iim*jjm,llm+1) 
    100   REAL(rstd) :: alpha(iim*jjm,llm),beta(iim*jjm,llm) 
    101   REAL(rstd) :: delta 
    102   REAL(rstd) :: pks(iim*jjm),pk(iim*jjm,llm) 
    103   REAL(rstd) :: phi(iim*jjm,llm) 
    104   REAL(rstd) :: x   
    105   REAL(rstd) :: fact(3*iim*jjm) 
    106   REAL(rstd) :: ut(3*iim*jjm,llm) 
    107  
    108   REAL(rstd) :: teta0,ttp,delt_y,delt_z,eps 
    109   REAL(rstd) :: k_f,k_c_a,k_c_s 
    110   REAL(rstd) :: zz,ran1 
    111   REAL(rstd) :: tetastrat,tetajl(iim*jjm,llm)  
    112   REAL(rstd) :: slat(iim*jjm)  
    113 !-------------choces of parametes and get it   
    114      k_f=1.                !friction  
    115      CALL getin('k_j',k_f) 
    116      k_f=1./(daysec*k_f) 
    117      k_c_s=4.  !cooling surface 
    118      CALL getin('k_c_s',k_c_s) 
    119      k_c_s=1./(daysec*k_c_s) 
    120      k_c_a=40. !cooling free atm 
    121      CALL getin('k_c_a',k_c_a) 
    122      k_c_a=1./(daysec*k_c_a) 
    123      ! Constants for Teta equilibrium profile 
    124      teta0=315.     ! mean Teta (S.H. 315K) 
    125      CALL getin('teta0',teta0) 
    126      ttp=200.       ! Tropopause temperature (S.H. 200K) 
    127      CALL getin('ttp',ttp) 
    128      eps=0.         ! Deviation to N-S symmetry(~0-20K) 
    129      CALL getin('eps',eps) 
    130      delt_y=60.     ! Merid Temp. Gradient (S.H. 60K) 
    131      CALL getin('delt_y',delt_y) 
    132      delt_z=10.     ! Vertical Gradient (S.H. 10K) 
    133      CALL getin('delt_z',delt_z) 
    134 !----------------------------------------------------------- 
    135     knewt_g=k_c_a  
    136     DO l=1,llm 
    137        zsig=ap(l)/preff+bp(l) 
    138        knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)  
    139        kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)  
    140     ENDDO 
    141          DO j=jj_begin-1,jj_end+1 
    142            DO i=ii_begin-1,ii_end+1 
    143              ij=(j-1)*iim+i 
    144              CALL xyz2lonlat(xyz_i(ij,:),lon,lat) 
    145              clat(ij)=cos(lat)  
    146              slat(ij)=sin(lat)  
    147             ENDDO 
    148          ENDDO 
     94  SUBROUTINE init_Teq 
     95    USE icosa 
     96    USE disvert_mod, ONLY : ap,bp 
     97    IMPLICIT NONE 
     98    REAL(rstd),POINTER :: clat(:)  
     99    REAL(rstd),POINTER :: theta_eq(:,:)  
     100    REAL(rstd) :: zsig 
     101    INTEGER :: ind, l 
     102 
     103    IF(.NOT.done) THEN 
     104       done = .TRUE. 
     105        
     106       CALL allocate_field(f_theta,field_t,type_real,llm) 
     107       CALL allocate_field(f_theta_eq,field_t,type_real,llm) 
     108       CALL allocate_field(f_clat,field_t,type_real) 
     109       ALLOCATE(knewt_t(llm)); ALLOCATE( kfrict(llm))  
     110 
     111       k_f=1.                !friction  
     112       CALL getin('k_j',k_f) 
     113       k_f=1./(daysec*k_f) 
     114       k_c_s=4.  !cooling surface 
     115       CALL getin('k_c_s',k_c_s) 
     116       k_c_s=1./(daysec*k_c_s) 
     117       k_c_a=40. !cooling free atm 
     118       CALL getin('k_c_a',k_c_a) 
     119       k_c_a=1./(daysec*k_c_a) 
     120       ! Constants for Teta equilibrium profile 
     121       teta0=315.     ! mean Teta (S.H. 315K) 
     122       CALL getin('teta0',teta0) 
     123       ttp=200.       ! Tropopause temperature (S.H. 200K) 
     124       CALL getin('ttp',ttp) 
     125       eps=0.         ! Deviation to N-S symmetry(~0-20K) 
     126       CALL getin('eps',eps) 
     127       delt_y=60.     ! Merid Temp. Gradient (S.H. 60K) 
     128       CALL getin('delt_y',delt_y) 
     129       delt_z=10.     ! Vertical Gradient (S.H. 10K) 
     130       CALL getin('delt_z',delt_z) 
     131 
     132       !----------------------------------------------------------- 
     133       knewt_g=k_c_a  
     134       DO l=1,llm 
     135          zsig=ap(l)/preff+bp(l) 
     136          knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)  
     137          kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)  
     138       ENDDO 
     139 
     140       DO ind=1,ndomain 
     141          CALL swap_dimensions(ind) 
     142          CALL swap_geometry(ind) 
     143          clat=f_clat(ind) 
     144          theta_eq=f_theta_eq(ind) 
     145          CALL compute_Teq(clat,theta_eq) 
     146       ENDDO 
     147 
     148    ELSE 
     149       PRINT *, 'Init_Teq called twice' 
     150       CALL ABORT 
     151    END IF 
     152 
     153  END SUBROUTINE init_Teq 
     154 
     155  SUBROUTINE compute_Teq(clat,theta_eq) 
     156    USE icosa 
     157    USE disvert_mod 
     158    IMPLICIT NONE   
     159    REAL(rstd),INTENT(OUT) :: clat(iim*jjm) 
     160    REAL(rstd),INTENT(OUT) :: theta_eq(iim*jjm,llm)  
     161 
     162    REAL(rstd) :: lon, lat, r, zsig, ddsin, tetastrat, tetajl 
     163    REAL(rstd) :: slat(iim*jjm)  
     164    INTEGER :: i,j,l,ij 
     165 
     166    DO j=jj_begin-1,jj_end+1 
     167       DO i=ii_begin-1,ii_end+1 
     168          ij=(j-1)*iim+i 
     169          CALL xyz2lonlat(xyz_i(ij,:),lon,lat) 
     170          clat(ij)=cos(lat)  
     171          slat(ij)=sin(lat)  
     172       ENDDO 
     173    ENDDO 
    149174 
    150175    DO l=1,llm 
    151176       zsig=ap(l)/preff+bp(l) 
    152177       tetastrat=ttp*zsig**(-kappa) 
    153          DO j=jj_begin-1,jj_end+1 
    154            DO i=ii_begin-1,ii_end+1 
     178       DO j=jj_begin-1,jj_end+1 
     179          DO i=ii_begin-1,ii_end+1 
    155180             ij=(j-1)*iim+i 
    156181             ddsin=slat(ij)  
    157              tetajl(ij,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin & 
    158                 -delt_z*(1.-ddsin*ddsin)*log(zsig) 
    159              tetajl(ij,l)=MAX(tetajl(ij,l),tetastrat)  
    160              tetarappel(ij,l)=tetajl(ij,l)  
    161             ENDDO 
    162           ENDDO 
    163         ENDDO  
    164       
    165      DO j=jj_begin-1,jj_end+1 
    166        DO i=ii_begin-1,ii_end+1 
    167          ij=(j-1)*iim+i 
    168          ps(ij)=100000.0 
    169          phis(ij)=0.0 
    170        ENDDO 
    171      ENDDO 
    172       
    173  
    174     CALL compute_pression(ps,p,1)      
    175     CALL compute_exner(ps,p,pks,pk,1)   
    176         theta(:,:)=tetarappel(:,:)  
    177     CALL compute_geopotential(phis,pks,pk,theta,phi,1) 
    178  
    179         u=0.0 !!wind 0  
    180 !============================================================ 
    181      DO l=1,llm 
    182       DO j=jj_begin-1,jj_end+1 
    183         DO i=ii_begin-1,ii_end+1 
    184           ij=(j-1)*iim+i 
    185           CALL RANDOM_NUMBER(r); r = 0.0  
    186           theta(ij,l)=theta(ij,l)*(1.+0.0005*r) 
    187        ENDDO 
    188       ENDDO 
    189      ENDDO 
    190     CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 
     182             tetajl=teta0-delt_y*ddsin*ddsin+eps*ddsin & 
     183                  -delt_z*(1.-ddsin*ddsin)*log(zsig) 
     184             theta_eq(ij,l)=MAX(tetajl,tetastrat)  
     185          ENDDO 
     186       ENDDO 
     187    ENDDO 
     188  END SUBROUTINE compute_Teq 
     189 
     190  SUBROUTINE compute_etat0_heldsz(theta_eq, theta) 
     191    USE icosa 
     192    USE disvert_mod 
     193    USE pression_mod 
     194    USE exner_mod 
     195    USE geopotential_mod 
     196    USE theta2theta_rhodz_mod 
     197    IMPLICIT NONE   
     198    REAL(rstd),INTENT(IN) :: theta_eq(iim*jjm,llm)  
     199    REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm)  
     200 
     201    REAL(rstd) :: r  ! random number 
     202    INTEGER :: i,j,l,ij 
     203 
     204    DO l=1,llm 
     205       DO j=jj_begin-1,jj_end+1 
     206          DO i=ii_begin-1,ii_end+1 
     207             ij=(j-1)*iim+i 
     208             CALL RANDOM_NUMBER(r); r = 0.0  
     209             theta(ij,l)=theta_eq(ij,l)*(1.+0.0005*r) 
     210          ENDDO 
     211       ENDDO 
     212    ENDDO 
    191213 
    192214  END SUBROUTINE compute_etat0_heldsz 
    193215 
    194216 
    195         SUBROUTINE held_saurez(f_ps,f_theta_rhodz,f_u)  
    196         USE icosa 
    197             IMPLICIT NONE 
     217  SUBROUTINE held_suarez(f_ps,f_theta_rhodz,f_u)  
     218    USE icosa 
     219    IMPLICIT NONE 
    198220    TYPE(t_field),POINTER :: f_theta_rhodz(:) 
    199221    TYPE(t_field),POINTER :: f_u(:) 
    … …  
    202224    REAL(rstd),POINTER :: u(:,:) 
    203225    REAL(rstd),POINTER :: ps(:) 
    204     REAL(rstd),POINTER :: tetarappel(:,:) 
     226    REAL(rstd),POINTER :: theta_eq(:,:) 
     227    REAL(rstd),POINTER :: theta(:,:) 
    205228    REAL(rstd),POINTER :: clat(:) 
    206229    INTEGER::ind 
    207230 
    208231    DO ind=1,ndomain 
    209       CALL swap_dimensions(ind) 
    210       CALL swap_geometry(ind) 
    211       theta_rhodz=f_theta_rhodz(ind) 
    212       u=f_u(ind) 
    213       ps=f_ps(ind)  
    214       tetarappel=f_tetarappel(ind)  
    215       clat=f_clat(ind)  
    216       CALL compute_heldsz(ps,theta_rhodz,u,clat,tetarappel)  
    217     ENDDO 
    218         END SUBROUTINE held_saurez  
    219  
    220         SUBROUTINE compute_heldsz(ps,theta_rhodz,u,clat,tetarappel)  
    221         USE icosa 
    222         USE theta2theta_rhodz_mod 
    223            IMPLICIT NONE 
    224    REAL(rstd),INTENT(IN)::ps(iim*jjm)  
    225    REAL(rstd),INTENT(INOUT) :: theta_rhodz(iim*jjm,llm) 
    226    REAL(rstd),INTENT(INOUT) :: u(3*iim*jjm,llm) 
    227    REAL(rstd)::theta(iim*jjm,llm)  
    228    REAL(rstd),INTENT(IN)::tetarappel(iim*jjm,llm)  
    229    REAL(rstd),INTENT(IN):: clat(iim*jjm)  
    230    INTEGER :: i,j,l,ij 
    231  
    232       CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1) 
     232       CALL swap_dimensions(ind) 
     233       CALL swap_geometry(ind) 
     234       theta_rhodz=f_theta_rhodz(ind) 
     235       u=f_u(ind) 
     236       ps=f_ps(ind)  
     237       theta_eq=f_theta_eq(ind)  
     238       theta=f_theta(ind)  
     239       clat=f_clat(ind)  
     240       CALL compute_heldsz(ps,theta_eq,clat, theta_rhodz,u, theta)  
     241    ENDDO 
     242  END SUBROUTINE held_suarez 
     243 
     244  SUBROUTINE compute_heldsz(ps,theta_eq,clat, theta_rhodz,u, theta)  
     245    USE icosa 
     246    USE theta2theta_rhodz_mod 
     247    IMPLICIT NONE 
     248    REAL(rstd),INTENT(IN)    :: ps(iim*jjm)  
     249    REAL(rstd),INTENT(IN)    :: theta_eq(iim*jjm,llm)  
     250    REAL(rstd),INTENT(IN)    :: clat(iim*jjm)  
     251    REAL(rstd),INTENT(INOUT) :: theta_rhodz(iim*jjm,llm) 
     252    REAL(rstd),INTENT(INOUT) :: u(3*iim*jjm,llm) 
     253    REAL(rstd),INTENT(OUT)   :: theta(iim*jjm,llm)  
     254 
     255    INTEGER :: i,j,l,ij 
     256 
     257    CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1) 
    233258    DO l=1,llm 
    234       DO j=jj_begin-1,jj_end+1 
    235         DO i=ii_begin-1,ii_end+1 
    236           ij=(j-1)*iim+i 
    237         theta(ij,l)=theta(ij,l) - dt*(theta(ij,l)-tetarappel(ij,l))* & 
    238         (knewt_g+knewt_t(l)*clat(ij)**4 ) 
    239         ENDDO 
    240       ENDDO 
    241     ENDDO  
    242        CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 
    243  
    244         Do l=1,llm 
    245         u(:,l)=u(:,l)*(1.-dt*kfrict(l)) 
    246         END DO 
    247  
    248           END SUBROUTINE compute_heldsz 
     259       DO j=jj_begin-1,jj_end+1 
     260          DO i=ii_begin-1,ii_end+1 
     261             ij=(j-1)*iim+i 
     262             theta(ij,l)=theta(ij,l) - dt*(theta(ij,l)-theta_eq(ij,l))* & 
     263                  (knewt_g+knewt_t(l)*clat(ij)**4 ) 
     264          ENDDO 
     265       ENDDO 
     266    ENDDO 
     267    CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 
     268 
     269    Do l=1,llm 
     270       u(:,l)=u(:,l)*(1.-dt*kfrict(l)) 
     271    END DO 
     272 
     273  END SUBROUTINE compute_heldsz 
    249274 
    250275END MODULE etat0_heldsz_mod 

  • codes/icosagcm/trunk/src/physics.f90

    r149 r170  
    11MODULE physics_mod 
    22 
    3   CHARACTER(LEN=255) :: physics_type="none" 
     3  CHARACTER(LEN=255) :: physics_type="automatic" 
    44 
    55 
    … …  
    77 
    88  SUBROUTINE init_physics 
    9   USE icosa 
    10   USE physics_dcmip_mod,init_physics_dcmip=>init_physics 
    11   USE physics_dry_mod 
    12   IMPLICIT NONE 
    13      
     9    USE icosa 
     10    USE physics_dcmip_mod,init_physics_dcmip=>init_physics 
     11    USE physics_dry_mod 
     12    IMPLICIT NONE 
     13 
    1414    CALL getin("physics",physics_type) 
    15      
     15 
    1616    SELECT CASE(TRIM(physics_type)) 
    17       CASE ('none') 
    18      
    19       CASE ('dcmip') 
    20         CALL init_physics_dcmip 
     17    CASE ('automatic') 
    2118 
    22       CASE ('lmd') 
    23         CALL init_physics_dry 
    24        
    25       CASE DEFAULT 
    26          PRINT*, 'Bad selector for variable physics init <',physics_type, & 
    27               '> options are <none>, <dcmip>,' 
     19    CASE ('dcmip') 
     20       CALL init_physics_dcmip 
    2821 
     22    CASE ('dry') 
     23       CALL init_physics_dry 
     24 
     25    CASE DEFAULT 
     26       PRINT*, 'init_physics : Bad selector for variable physics <',TRIM(physics_type), & 
     27            '> options are <automatic>, <dcmip>, <dry>' 
     28       STOP 
    2929    END SELECT 
    30      
     30 
    3131  END SUBROUTINE init_physics 
    3232 
    3333  SUBROUTINE physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
    34   USE icosa 
    35   USE physics_dry_mod 
    36   USE physics_dcmip_mod, physics_dcmip=>physics 
    37   USE etat0_mod 
    38   USE etat0_heldsz_mod 
    39   IMPLICIT NONE 
     34    USE icosa 
     35    USE physics_dry_mod 
     36    USE physics_dcmip_mod, physics_dcmip=>physics 
     37    USE etat0_mod 
     38    USE etat0_heldsz_mod 
     39    IMPLICIT NONE 
    4040    INTEGER, INTENT(IN)   :: it 
    4141    REAL(rstd),INTENT(IN)::jD_cur,jH_cur 
    … …  
    4646    TYPE(t_field),POINTER :: f_q(:) 
    4747    LOGICAL:: firstcall,lastcall 
    48      
     48 
    4949    SELECT CASE(TRIM(physics_type)) 
    50       CASE ('none') 
     50    CASE ('automatic') 
    5151 
    52         SELECT CASE(TRIM(etat0_type)) 
    53         CASE('heldsz')  
    54 !       CALL transfert_request(f_ps,req_i1) 
    55 !       CALL transfert_request(f_theta_rhodz,req_i1) 
    56 !       CALL transfert_request(f_ue,req_e1_vect) 
    57 !       CALL held_saurez(f_ps,f_theta_rhodz,f_ue)  
    58         CASE DEFAULT 
    59         PRINT*,"NO PHYSICAL PACAKAGE USED"  
    60         END SELECT 
    61      
    62       CASE ('dcmip') 
    63         CALL physics_dcmip(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
     52       SELECT CASE(TRIM(etat0_type)) 
     53       CASE('held_suarez') 
     54          !     CALL transfert_request(f_ps,req_i1) 
     55          !     CALL transfert_request(f_theta_rhodz,req_i1) 
     56          !     CALL transfert_request(f_ue,req_e1_vect) 
     57          CALL held_suarez(f_ps,f_theta_rhodz,f_ue)  
     58       CASE DEFAULT 
     59          PRINT*,"NO PHYSICAL PACAKAGE USED" ! FIXME MPI 
     60       END SELECT 
    6461 
    65       CASE ('dry') 
    66         CALL physics_dry(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
    67        
    68       CASE DEFAULT 
    69          PRINT*, 'Bad selector for variable physics <',physics_type, & 
    70               '> options are <none>, <dcmip>,' 
    71   STOP 
     62    CASE ('dcmip') 
     63       CALL physics_dcmip(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
     64 
     65    CASE ('dry') 
     66       CALL physics_dry(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 
     67 
     68    CASE DEFAULT 
     69       PRINT*, 'Bad selector for variable physics <',TRIM(physics_type), & 
     70            '> options are <automatic>, <dcmip>, <dry>' 
     71       STOP 
    7272    END SELECT 
    73      
     73 
    7474  END SUBROUTINE physics 
    7575 

  • codes/icosagcm/trunk/src/timeloop_gcm.f90

    r167 r170  
    303303 
    304304!---------------------------------------------------- 
    305 !    jD_cur = jD_ref + day_ini - day_ref + it/day_step 
    306 !    jH_cur = jH_ref + start_time + mod(it,day_step)/float(day_step) 
    307 !    jD_cur = jD_cur + int(jH_cur) 
    308 !    jH_cur = jH_cur - int(jH_cur) 
    309 !    CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 
    310  
    311 !    CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 
     305    jD_cur = jD_ref + day_ini - day_ref + it/day_step 
     306    jH_cur = jH_ref + start_time + mod(it,day_step)/float(day_step) 
     307    jD_cur = jD_cur + int(jH_cur) 
     308    jH_cur = jH_cur - int(jH_cur) 
     309    CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 
    312310    ENDDO 
    313311 
Note: See TracChangeset for help on using the changeset viewer.