source: codes/icosagcm/trunk/src/output/write_etat0.f90 @ 882

Last change on this file since 882 was 882, checked in by ymipsl, 5 years ago

Metric is now write in start.nc/restart.nc
Metric can be read at restart if read_metric=y.

YM
File size: 2.3 KB
Line 
1MODULE write_etat0_mod
2
3
4
5CONTAINS
6
7  SUBROUTINE write_etat0(it,f_ps,f_phis,f_theta_rhodz,f_u, f_q, f_geopot, f_W)
8  USE icosa
9  USE restart_mod
10  USE wind_mod
11  USE write_field_mod
12  USE domain_mod
13  USE omp_para
14  USE xios_mod
15  IMPLICIT NONE
16    INTEGER,INTENT(IN)    :: it
17    TYPE(t_field),POINTER :: f_ps(:)
18    TYPE(t_field),POINTER :: f_phis(:)
19    TYPE(t_field),POINTER :: f_theta_rhodz(:)
20    TYPE(t_field),POINTER :: f_u(:)
21    TYPE(t_field),POINTER :: f_q(:)
22    TYPE(t_field),POINTER, OPTIONAL :: f_geopot(:)
23    TYPE(t_field),POINTER, OPTIONAL :: f_W(:)
24 
25    TYPE(t_field),POINTER,SAVE :: f_ulon(:)
26    TYPE(t_field),POINTER,SAVE :: f_ulat(:)
27    TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:)
28    TYPE(t_field),POINTER,SAVE :: f_xcell(:),f_ycell(:),f_zcell(:)
29    REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:)
30    REAL(rstd), POINTER :: xcell(:), ycell(:), zcell(:)
31    INTEGER :: ind
32   
33   
34    CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
35    CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
36    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
37    CALL allocate_field(f_xcell,field_t,type_real,name='xcell')
38    CALL allocate_field(f_ycell,field_t,type_real,name='ycell')
39    CALL allocate_field(f_zcell,field_t,type_real,name='zcell')
40
41!$OMP BARRIER   
42    DO ind=1, ndomain
43       IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
44       CALL swap_dimensions(ind)
45       CALL swap_geometry(ind)
46       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
47       theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
48       xcell=f_xcell(ind) ; xcell=xyz_i(:,1)/radius
49       ycell=f_ycell(ind) ; ycell=xyz_i(:,2)/radius
50       zcell=f_zcell(ind) ; zcell=xyz_i(:,3)/radius
51    ENDDO
52   
53    CALL transfert_request(f_u,req_e1_vect)
54    CALL un2ulonlat(f_u, f_ulon, f_ulat)
55
56    IF(hydrostatic) THEN
57       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_xcell, f_ycell, f_zcell )
58    ELSE
59       CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_geopot, f_W, f_xcell, f_ycell, f_zcell)
60    END IF
61    CALL deallocate_field(f_ulon)
62    CALL deallocate_field(f_ulat)
63   
64  END SUBROUTINE write_etat0
65   
66END MODULE write_etat0_mod
Note: See TracBrowser for help on using the repository browser.