Ignore:
Timestamp:
09/12/16 14:39:01 (8 years ago)
Author:
ymipsl
Message:

Bug fix : read and write restart file was brocken due to new extra dimension to theta_rhodz

YM

File:
1 edited

Legend:

Unmodified
Added
Removed
  • codes/icosagcm/trunk/src/write_etat0.f90

    r347 r476  
    1010  USE wind_mod 
    1111  USE write_field_mod 
     12  USE domain_mod 
     13  USE omp_para 
    1214  IMPLICIT NONE 
    1315    INTEGER,INTENT(IN)    :: it 
     
    2022    TYPE(t_field),POINTER,SAVE :: f_ulon(:) 
    2123    TYPE(t_field),POINTER,SAVE :: f_ulat(:) 
     24    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:) 
     25    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:) 
     26    INTEGER :: ind 
    2227     
    2328     
    2429    CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon') 
    2530    CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat') 
     31    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz') 
    2632 
     33!$OMP BARRIER     
     34    DO ind=1, ndomain 
     35       IF (.NOT. assigned_domain(ind) .AND. is_omp_level_master) CYCLE 
     36       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind) 
     37       theta_rhodz_1d(:,:)=theta_rhodz(:,:,1) 
     38    ENDDO 
     39     
    2740    CALL transfert_request(f_u,req_e1_vect) 
    2841    CALL un2ulonlat(f_u, f_ulon, f_ulat) 
    2942     
    30     CALL write_restart(it,f_ps,f_phis,f_theta_rhodz,f_u, f_ulon, f_ulat, f_q) 
     43    CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q) 
    3144 
    3245    CALL deallocate_field(f_ulon) 
Note: See TracChangeset for help on using the changeset viewer.