source: codes/icosagcm/devel/src/output/write_etat0.f90

Last change on this file was 992, checked in by rpennel, 5 years ago

devel : add reading metrics from file at init (folllowing revs @882, @887, @888)

[ !! needs to rewrite new subroutine in xios_mod using cellset strcuture ]

File size: 2.3 KB
Line 
1MODULE write_etat0_mod
2
3CONTAINS
4
5  SUBROUTINE write_etat0(it,f_ps,f_phis,f_theta_rhodz,f_u, f_q, f_geopot, f_W)
6  USE icosa
7  USE restart_mod
8  USE wind_mod
9  USE write_field_mod
10  USE domain_mod
11  USE omp_para
12  USE xios_mod
13  USE caldyn_vars_mod
14  USE grid_param
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    IF(grid_type == grid_unst) RETURN
34
35    CALL allocate_field(f_ulon,field_t,type_real,llm,name='ulon')
36    CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat')
37    CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz')
38    CALL allocate_field(f_xcell,field_t,type_real,name='xcell')
39    CALL allocate_field(f_ycell,field_t,type_real,name='ycell')
40    CALL allocate_field(f_zcell,field_t,type_real,name='zcell')
41
42!$OMP BARRIER   
43    DO ind=1, ndomain
44       IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE
45       CALL swap_dimensions(ind)
46       CALL swap_geometry(ind)
47       theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind)
48       theta_rhodz_1d(:,:)=theta_rhodz(:,:,1)
49       xcell=f_xcell(ind) ; xcell=xyz_i(:,1)/radius
50       ycell=f_ycell(ind) ; ycell=xyz_i(:,2)/radius
51       zcell=f_zcell(ind) ; zcell=xyz_i(:,3)/radius
52    ENDDO
53   
54    CALL transfert_request(f_u,req_e1_vect)
55    CALL un2ulonlat(f_u, f_ulon, f_ulat)
56
57    IF(hydrostatic) THEN
58       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 )
59    ELSE
60       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)
61    END IF
62    CALL deallocate_field(f_ulon)
63    CALL deallocate_field(f_ulat)
64   
65  END SUBROUTINE write_etat0
66   
67END MODULE write_etat0_mod
Note: See TracBrowser for help on using the repository browser.