Changeset 397
- Timestamp:
- 06/06/16 20:41:52 (8 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/observable.f90
r387 r397 10 10 TYPE(t_field),POINTER, SAVE :: f_buf1_i(:), f_buf2_i(:) 11 11 TYPE(t_field),POINTER, SAVE :: f_buf_v(:), f_buf_s(:), f_buf_p(:) 12 TYPE(t_field),POINTER, SAVE :: f_pmid(:) 12 13 13 14 ! temporary shared variable for caldyn … … 15 16 16 17 PUBLIC init_observable, write_output_fields_basic, f_theta 17 18 LOGICAL,SAVE :: first_output=.TRUE. 19 !$OMP THREADPRIVATE(first_output) 20 18 21 CONTAINS 19 22 20 23 SUBROUTINE init_observable 21 24 CALL allocate_field(f_buf_i, field_t,type_real,llm,name="buffer_i") 25 CALL allocate_field(f_buf1_i, field_t,type_real,llm,name="buffer1_i") 26 CALL allocate_field(f_buf2_i, field_t,type_real,llm,name="buffer2_i") 22 27 CALL allocate_field(f_buf_p, field_t,type_real,llm+1) 23 28 CALL allocate_field(f_buf_u3d, field_t,type_real,3,llm) ! 3D vel at cell centers … … 29 34 30 35 CALL allocate_field(f_theta, field_t,type_real,llm, name='theta') ! potential temperature 36 CALL allocate_field(f_pmid, field_t,type_real,llm, name='pmid') ! mid layer pressure 31 37 END SUBROUTINE init_observable 32 38 33 SUBROUTINE write_output_fields_basic(f_ps, f_mass, f_geopot, f_ u, f_W, f_q)39 SUBROUTINE write_output_fields_basic(f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q) 34 40 USE wind_mod 35 41 USE output_field_mod 36 42 USE omp_para 37 TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_geopot(:), f_u(:), f_W(:), f_q(:) 43 USE time_mod 44 USE xios 45 USE disvert_mod 46 USE earth_const 47 USE pression_mod 48 USE vertical_interp_mod 49 USE theta2theta_rhodz_mod 50 USE wind_mod 51 USE omega_mod 52 53 TYPE(t_field),POINTER :: f_ps(:), f_mass(:), f_geopot(:), f_theta_rhodz(:), f_u(:), f_W(:), f_q(:) 38 54 ! IF (is_master) PRINT *,'CALL write_output_fields_basic' 55 REAL :: scalar(1) 56 REAL :: mid_ap(llm) 57 REAL :: mid_bp(llm) 58 INTEGER :: l 59 60 IF (first_output) THEN 61 scalar(1)=dt 62 CALL xios_send_field("timestep", scalar) 63 scalar(1)=preff 64 CALL xios_send_field("preff", scalar) 65 CALL xios_send_field("ap",ap) 66 CALL xios_send_field("bp",bp) 67 DO l=1,llm 68 mid_ap(l)=(ap(l)+ap(l+1))/2 69 mid_bp(l)=(bp(l)+bp(l+1))/2 70 ENDDO 71 CALL xios_send_field("mid_ap",mid_ap) 72 CALL xios_send_field("mid_bp",mid_bp) 73 74 first_output=.FALSE. 75 ENDIF 76 39 77 CALL progonostic_vel_to_horiz(f_geopot, f_ps, f_mass, f_u, f_W, f_buf_uh, f_buf_i) 40 78 CALL transfert_request(f_buf_uh,req_e1_vect) 41 79 CALL output_field("uz",f_buf_i) 80 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,85000.) 81 CALL output_field("w850",f_buf_s) 82 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,50000.) 83 CALL output_field("w500",f_buf_s) 84 85 42 86 CALL un2ulonlat(f_buf_uh, f_buf_ulon, f_buf_ulat) 43 87 CALL output_field("ulon",f_buf_ulon) … … 45 89 CALL output_field("ps",f_ps) 46 90 CALL output_field("Ai",geom%Ai) 91 47 92 ! CALL output_field("dps",f_dps) 48 93 CALL output_field("mass",f_mass) … … 50 95 ! CALL output_field("dmass",f_dmass) 51 96 ! CALL output_field("vort",f_qv) 52 CALL output_field("theta",f_theta) 97 98 99 CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_buf_i) ; 100 CALL Tv2T(f_buf_i,f_q,f_buf1_i) 101 CALL output_field("temp",f_buf_i) 102 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,85000.) 103 CALL output_field("t850",f_buf_s) 104 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,50000.) 105 CALL output_field("t500",f_buf_s) 106 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,preff) 107 CALL output_field("SST",f_buf_s) 108 109 110 CALL extract_slice(f_theta_rhodz, f_buf_i,1) 111 CALL output_field("theta",f_buf_i) 112 53 113 ! CALL output_field("exner",f_pk) 54 114 ! CALL output_field("pv",f_qv) 55 115 CALL output_field("q",f_q) 116 CALL pression_mid(f_ps, f_pmid) 117 CALL output_field("p",f_pmid) 118 119 CALL vertical_interp(f_ps,f_buf_ulon,f_buf_s,85000.) 120 CALL output_field("u850",f_buf_s) 121 CALL vertical_interp(f_ps,f_buf_ulon,f_buf_s,50000.) 122 CALL output_field("u500",f_buf_s) 123 124 CALL vertical_interp(f_ps,f_buf_ulat,f_buf_s,85000.) 125 CALL output_field("v850",f_buf_s) 126 CALL vertical_interp(f_ps,f_buf_ulat,f_buf_s,50000.) 127 CALL output_field("v500",f_buf_s) 128 129 CALL w_omega(f_ps, f_u, f_buf_i) 130 CALL output_field("omega",f_buf_i) 131 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,85000.) 132 CALL output_field("omega850",f_buf_s) 133 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,50000.) 134 CALL output_field("omega500",f_buf_s) 135 136 137 56 138 END SUBROUTINE write_output_fields_basic 57 139 -
codes/icosagcm/trunk/src/physics_dcmip2016.f90
r386 r397 120 120 REAL(rstd) :: qfi(ngrid,llm,5) 121 121 122 REAL(rstd) :: rho(llm), z(llm), theta(llm) 122 REAL(rstd) :: rho(llm), z(llm), theta(llm), qv(llm),qc(llm),qr(llm) 123 123 REAL(rstd) :: lastz 124 124 REAL(rstd) :: dcl1,dcl2 125 INTEGER :: l,ll,ij125 INTEGER :: l,ll,ij 126 126 REAL(rstd) :: dt_phys, inv_dt 127 127 INTEGER :: simple_physic_testcase 128 128 129 ! prepare input fields and mirror vertical index 129 130 ps(:) = p(:,1) ! surface pressure … … 147 148 ENDDO 148 149 150 149 151 IF (testcase==moist_baroclinic .OR. testcase==cyclone ) THEN 150 CALL simple_physics(ngrid, llm, dt_phys, lat, tfi, qfi(:,:,1) , ufi, vfi, pmid, pint, pdel, 1./pdel, ps, precl, 1, .FALSE., .FALSE.) 152 IF (testcase==moist_baroclinic) simple_physic_testcase=1 153 IF (testcase==cyclone) simple_physic_testcase=0 154 CALL simple_physics(ngrid, llm, dt_phys, lat, tfi, qfi(:,:,1) , ufi, vfi, pmid, pint, pdel, 1./pdel, ps, precl, & 155 simple_physic_testcase, .TRUE., .FALSE.) 151 156 ENDIF 152 157 … … 164 169 ENDDO 165 170 166 CALL KESSLER(theta(:), qfi(ij,llm:1:-1,1), qfi(ij,llm:1:-1,2), qfi(ij,llm:1:-1,3), rho(:), & 167 pk(ij,:), dt_phys, z(:), llm, precl(ij)) 171 qv(:)=qfi(ij,llm:1:-1,1) 172 qc(:)=qfi(ij,llm:1:-1,2) 173 qr(:)=qfi(ij,llm:1:-1,3) 174 175 ! CALL KESSLER(theta(:), qv, qc, qr, rho(:), & 176 ! pk(ij,:), dt_phys, z(:), llm, precl(ij)) 177 168 178 169 179 DO l=1,llm … … 172 182 Tfi(ij,ll) = theta(l) * ( pk(ij,l) / cpp) 173 183 ENDDO 184 185 qfi(ij,:,1)=qv(llm:1:-1) 186 qfi(ij,:,2)=qc(llm:1:-1) 187 qfi(ij,:,3)=qr(llm:1:-1) 188 174 189 ENDDO 175 190 ENDIF -
codes/icosagcm/trunk/src/pression.f90
r295 r397 25 25 26 26 END SUBROUTINE pression 27 28 SUBROUTINE pression_mid(f_ps,f_pmid) 29 USE icosa 30 IMPLICIT NONE 31 TYPE(t_field), POINTER :: f_ps(:) 32 TYPE(t_field), POINTER :: f_pmid(:) 27 33 34 REAL(rstd), POINTER :: ps(:) 35 REAL(rstd), POINTER :: pmid(:,:) 36 INTEGER :: ind 37 38 !$OMP BARRIER 39 DO ind=1,ndomain 40 IF (.NOT. assigned_domain(ind)) CYCLE 41 CALL swap_dimensions(ind) 42 CALL swap_geometry(ind) 43 ps=f_ps(ind) 44 pmid=f_pmid(ind) 45 CALL compute_pression_mid(ps, pmid,0) 46 ENDDO 47 !$OMP BARRIER 48 49 END SUBROUTINE pression_mid 50 28 51 SUBROUTINE compute_pression(ps,p,offset) 29 52 USE icosa … … 49 72 50 73 END SUBROUTINE compute_pression 74 75 SUBROUTINE compute_pression_mid(ps,pmid,offset) 76 USE icosa 77 USE disvert_mod 78 USE omp_para 79 IMPLICIT NONE 80 REAL(rstd),INTENT(IN) :: ps(iim*jjm) 81 REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm) 82 INTEGER,INTENT(IN) :: offset 83 INTEGER :: i,j,ij,l 84 85 IF(ap_bp_present) THEN 86 DO l = ll_begin, ll_end 87 DO j=jj_begin-offset,jj_end+offset 88 DO i=ii_begin-offset,ii_end+offset 89 ij=(j-1)*iim+i 90 pmid(ij,l) = 0.5*(ap(l)+ap(l+1) + (bp(l)+bp(l+1)) * ps(ij)) 91 ENDDO 92 ENDDO 93 ENDDO 94 END IF 95 96 END SUBROUTINE compute_pression_mid 51 97 52 98 END MODULE pression_mod -
codes/icosagcm/trunk/src/timeloop_gcm.f90
r387 r397 251 251 IF (mod(it,itau_out)==0 ) THEN 252 252 CALL transfert_request(f_u,req_e1_vect) 253 CALL write_output_fields_basic(f_ps, f_mass, f_geopot, f_ u, f_W, f_q)253 CALL write_output_fields_basic(f_ps, f_mass, f_geopot, f_theta_rhodz, f_u, f_W, f_q) 254 254 ENDIF 255 255
Note: See TracChangeset
for help on using the changeset viewer.