[467] | 1 | MODULE etat0_database_mod |
---|
[913] | 2 | IMPLICIT NONE |
---|
[467] | 3 | |
---|
| 4 | |
---|
| 5 | CONTAINS |
---|
| 6 | |
---|
[483] | 7 | SUBROUTINE init_etat0 |
---|
[482] | 8 | USE xios_mod |
---|
[483] | 9 | USE omp_para |
---|
[467] | 10 | |
---|
[483] | 11 | IF (is_omp_master) THEN |
---|
| 12 | CALL xios_set_fieldgroup_attr("read_fields",enabled=.TRUE.) |
---|
| 13 | CALL xios_set_filegroup_attr("read_files",enabled=.TRUE.) |
---|
| 14 | ENDIF |
---|
| 15 | END SUBROUTINE init_etat0 |
---|
[467] | 16 | |
---|
| 17 | SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) |
---|
| 18 | USE icosa |
---|
| 19 | USE restart_mod |
---|
| 20 | USE wind_mod |
---|
| 21 | USE write_field_mod |
---|
| 22 | USE time_mod |
---|
| 23 | USE transfert_mod |
---|
| 24 | USE xios_mod |
---|
| 25 | USE write_field_mod |
---|
| 26 | USE vertical_remap_mod |
---|
| 27 | USE theta2theta_rhodz_mod |
---|
| 28 | USE qsat_mod |
---|
[913] | 29 | USE compute_pression_mod, ONLY : pression |
---|
[467] | 30 | USE omp_para |
---|
| 31 | TYPE(t_field),POINTER :: f_ps(:) |
---|
| 32 | TYPE(t_field),POINTER :: f_phis(:) |
---|
| 33 | TYPE(t_field),POINTER :: f_theta_rhodz(:) |
---|
| 34 | TYPE(t_field),POINTER :: f_u(:) |
---|
| 35 | TYPE(t_field),POINTER :: f_q(:) |
---|
| 36 | |
---|
| 37 | TYPE(t_field),POINTER,SAVE :: f_ulon_reg(:) |
---|
| 38 | TYPE(t_field),POINTER,SAVE :: f_ulat_reg(:) |
---|
| 39 | TYPE(t_field),POINTER,SAVE :: f_temp_reg(:) |
---|
| 40 | TYPE(t_field),POINTER,SAVE :: f_q_reg(:) |
---|
| 41 | |
---|
| 42 | TYPE(t_field),POINTER,SAVE :: f_ts(:) |
---|
| 43 | TYPE(t_field),POINTER,SAVE :: f_z(:) |
---|
| 44 | TYPE(t_field),POINTER,SAVE :: f_ulon(:) |
---|
| 45 | TYPE(t_field),POINTER,SAVE :: f_ulat(:) |
---|
| 46 | TYPE(t_field),POINTER,SAVE :: f_temp(:) |
---|
| 47 | TYPE(t_field),POINTER,SAVE :: f_q1(:) |
---|
| 48 | TYPE(t_field),POINTER,SAVE :: f_qsat(:) |
---|
| 49 | TYPE(t_field),POINTER,SAVE :: f_p(:) |
---|
| 50 | INTEGER :: nb_level |
---|
| 51 | REAL,ALLOCATABLE:: levels(:) |
---|
| 52 | INTEGER :: ind |
---|
| 53 | |
---|
[486] | 54 | CALL xios_read_field("relief_db",f_phis) |
---|
[467] | 55 | |
---|
| 56 | CALL writeField("relief_out",f_phis,once=.TRUE.) |
---|
| 57 | |
---|
[726] | 58 | IF (is_omp_level_master) THEN |
---|
| 59 | DO ind=1,ndomain |
---|
| 60 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 61 | f_phis(ind)%rval2d(:)=f_phis(ind)%rval2d(:)*g |
---|
| 62 | ENDDO |
---|
| 63 | ENDIF |
---|
| 64 | !$OMP BARRIER |
---|
[467] | 65 | |
---|
| 66 | IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn",n_glo=nb_level) |
---|
| 67 | CALL bcast_omp(nb_level) |
---|
| 68 | ALLOCATE(levels(nb_level)) |
---|
| 69 | |
---|
| 70 | IF (is_omp_master) CALL xios_get_axis_attr("lev_ecdyn",value=levels) |
---|
| 71 | CALL bcast_omp(levels) |
---|
| 72 | |
---|
| 73 | levels=levels*100 ! hectoPascal -> Pascal |
---|
| 74 | |
---|
| 75 | CALL allocate_field(f_ts, field_t, type_real, name="ts") |
---|
| 76 | CALL allocate_field(f_z, field_t, type_real, name="z") |
---|
| 77 | CALL allocate_field(f_ulon_reg, field_t, type_real,nb_level) |
---|
| 78 | CALL allocate_field(f_ulat_reg, field_t, type_real,nb_level) |
---|
| 79 | CALL allocate_field(f_temp_reg, field_t, type_real,nb_level) |
---|
| 80 | CALL allocate_field(f_q_reg, field_t, type_real,nb_level) |
---|
| 81 | |
---|
| 82 | CALL allocate_field(f_q1, field_t, type_real,llm) |
---|
| 83 | CALL allocate_field(f_qsat, field_t, type_real,llm) |
---|
| 84 | CALL allocate_field(f_p, field_t, type_real,llm+1) |
---|
| 85 | CALL allocate_field(f_temp, field_t, type_real,llm) |
---|
| 86 | CALL allocate_field(f_ulon, field_t, type_real,llm) |
---|
| 87 | CALL allocate_field(f_ulat, field_t, type_real,llm) |
---|
| 88 | |
---|
[486] | 89 | CALL xios_read_field("z_db",f_z) |
---|
| 90 | CALL xios_read_field("ps_db",f_ps) |
---|
| 91 | CALL xios_read_field("ts_db",f_ts) |
---|
[467] | 92 | CALL writeField("ps_out",f_ps) |
---|
| 93 | |
---|
| 94 | !$OMP BARRIER |
---|
| 95 | |
---|
| 96 | ! CALL writeField("phis_out",f_phis,once=.TRUE.) |
---|
| 97 | ! CALL writeField("ts_out",f_ts,once=.TRUE.) |
---|
| 98 | |
---|
| 99 | ! make correction to ps due to relief at higher resolution |
---|
| 100 | ! difference with LMDZ : tsol is taken from ECDYN.NC and not from ECPHY |
---|
[726] | 101 | IF (is_omp_level_master) THEN |
---|
| 102 | DO ind=1,ndomain |
---|
| 103 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 104 | f_ps(ind)%rval2d(:)=f_ps(ind)%rval2d(:)*(1.+(f_z(ind)%rval2d(:)-f_phis(ind)%rval2d(:))/287.0/f_ts(ind)%rval2d(:)) |
---|
| 105 | ENDDO |
---|
| 106 | ENDIF |
---|
| 107 | !$OMP BARRIER |
---|
[467] | 108 | CALL transfert_request(f_ps,req_i0) |
---|
| 109 | CALL writeField("ps_out",f_ps) |
---|
| 110 | |
---|
| 111 | |
---|
| 112 | |
---|
[486] | 113 | CALL xios_read_field("temp_db",f_temp_reg) |
---|
[467] | 114 | CALL vertical_remap(levels,f_temp_reg,f_ps,f_temp) |
---|
| 115 | CALL transfert_request(f_temp,req_i0) |
---|
| 116 | CALL temperature2theta_rhodz(f_ps,f_temp,f_theta_rhodz) |
---|
| 117 | |
---|
[486] | 118 | CALL xios_read_field("u_db",f_ulon_reg) |
---|
[467] | 119 | CALL vertical_remap(levels,f_ulon_reg,f_ps,f_ulon) |
---|
[486] | 120 | CALL xios_read_field("v_db",f_ulat_reg) |
---|
[467] | 121 | CALL vertical_remap(levels,f_ulat_reg,f_ps,f_ulat) |
---|
| 122 | CALL transfert_request(f_ulat,req_i0) |
---|
| 123 | CALL transfert_request(f_ulon,req_i0) |
---|
| 124 | CALL ulonlat2un(f_ulon, f_ulat,f_u) |
---|
| 125 | |
---|
[486] | 126 | CALL xios_read_field("q_db",f_q_reg) |
---|
[467] | 127 | CALL vertical_remap(levels,f_q_reg,f_ps,f_q1) |
---|
| 128 | |
---|
| 129 | CALL pression(f_ps,f_p) |
---|
| 130 | ! difference with LMDZ : for qsat, pressure at mid layer is computed as a mean value pmid=(p(l)+p(l+1))/2 |
---|
| 131 | CALL qsat(f_temp,f_p,f_qsat) |
---|
| 132 | CALL transfert_request(f_qsat,req_i0) |
---|
| 133 | |
---|
| 134 | DO ind=1,ndomain |
---|
| 135 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
[528] | 136 | f_q(ind)%rval4d(:,:,:)=1e-6 |
---|
[467] | 137 | f_q(ind)%rval4d(:,:,1)=f_q1(ind)%rval3d(:,:)*f_qsat(ind)%rval3d(:,:)*0.01 |
---|
| 138 | WHERE(f_q(ind)%rval4d(:,:,1)<0) f_q(ind)%rval4d(:,:,1)=0 |
---|
| 139 | ENDDO |
---|
| 140 | |
---|
[726] | 141 | CALL writeField("tempdb_out",f_temp_reg) |
---|
| 142 | CALL writeField("temp_out",f_temp) |
---|
[467] | 143 | |
---|
| 144 | CALL deallocate_field(f_ts) |
---|
| 145 | CALL deallocate_field(f_z) |
---|
| 146 | CALL deallocate_field(f_ulon_reg) |
---|
| 147 | CALL deallocate_field(f_ulat_reg) |
---|
| 148 | CALL deallocate_field(f_temp_reg) |
---|
| 149 | CALL deallocate_field(f_q_reg) |
---|
| 150 | |
---|
| 151 | CALL deallocate_field(f_q1) |
---|
| 152 | CALL deallocate_field(f_qsat) |
---|
| 153 | CALL deallocate_field(f_p) |
---|
| 154 | CALL deallocate_field(f_temp) |
---|
| 155 | CALL deallocate_field(f_ulon) |
---|
| 156 | CALL deallocate_field(f_ulat) |
---|
| 157 | |
---|
| 158 | END SUBROUTINE etat0 |
---|
| 159 | |
---|
| 160 | END MODULE etat0_database_mod |
---|