Changeset 110 for codes/icosagcm/trunk
- Timestamp:
- 08/07/12 19:10:05 (12 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/advect_tracer.f90
r98 r110 2 2 USE icosa 3 3 PRIVATE 4 INTEGER,PARAMETER::iapp_tracvl= 34 INTEGER,PARAMETER::iapp_tracvl= 1 5 5 6 6 TYPE(t_field),POINTER :: f_normal(:) -
codes/icosagcm/trunk/src/caldyn.f90
r98 r110 30 30 END SUBROUTINE init_caldyn 31 31 32 SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_ dps, f_dtheta_rhodz, f_du)32 SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q, f_dps, f_dtheta_rhodz, f_du) 33 33 USE icosa 34 34 USE caldyn_gcm_mod, ONLY : caldyn_gcm=>caldyn … … 40 40 TYPE(t_field),POINTER :: f_theta_rhodz(:) 41 41 TYPE(t_field),POINTER :: f_u(:) 42 TYPE(t_field),POINTER :: f_q(:) 42 43 TYPE(t_field),POINTER :: f_dps(:) 43 44 TYPE(t_field),POINTER :: f_dtheta_rhodz(:) … … 46 47 SELECT CASE (TRIM(caldyn_type)) 47 48 CASE('gcm') 48 CALL caldyn_gcm(it,f_phis, f_ps, f_theta_rhodz, f_u, f_ dps, f_dtheta_rhodz, f_du)49 CALL caldyn_gcm(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q, f_dps, f_dtheta_rhodz, f_du) 49 50 CASE('adv') 50 CALL caldyn_adv(it,f_phis, f_ps, f_theta_rhodz, f_u, f_ dps, f_dtheta_rhodz, f_du)51 CALL caldyn_adv(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q, f_dps, f_dtheta_rhodz, f_du) 51 52 END SELECT 52 53 -
codes/icosagcm/trunk/src/caldyn_adv.f90
r98 r110 79 79 80 80 81 SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_ dps, f_dtheta_rhodz, f_du)81 SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q, f_dps, f_dtheta_rhodz, f_du) 82 82 USE icosa 83 83 USE vorticity_mod … … 90 90 TYPE(t_field),POINTER :: f_theta_rhodz(:) 91 91 TYPE(t_field),POINTER :: f_u(:) 92 TYPE(t_field),POINTER :: f_q(:) 92 93 TYPE(t_field),POINTER :: f_dps(:) 93 94 TYPE(t_field),POINTER :: f_dtheta_rhodz(:) -
codes/icosagcm/trunk/src/caldyn_gcm.f90
r104 r110 74 74 END SUBROUTINE check_mass_conservation 75 75 76 SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_ dps, f_dtheta_rhodz, f_du)76 SUBROUTINE caldyn(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q, f_dps, f_dtheta_rhodz, f_du) 77 77 USE icosa 78 78 USE vorticity_mod … … 85 85 TYPE(t_field),POINTER :: f_theta_rhodz(:) 86 86 TYPE(t_field),POINTER :: f_u(:) 87 TYPE(t_field),POINTER :: f_q(:) 87 88 TYPE(t_field),POINTER :: f_dps(:) 88 89 TYPE(t_field),POINTER :: f_dtheta_rhodz(:) … … 123 124 IF (mod(it,itau_out)==0 ) THEN 124 125 PRINT *,'CALL write_output_fields' 125 CALL write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, &126 CALL write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, f_q, & 126 127 f_buf_i, f_buf_v, f_buf_u3d, f_buf_ulon, f_buf_ulat, f_buf_s, f_buf_p) 127 128 END IF … … 626 627 END SUBROUTINE compute_caldyn 627 628 628 SUBROUTINE write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, &629 SUBROUTINE write_output_fields(f_ps, f_phis, f_dps, f_u, f_theta_rhodz, f_q, & 629 630 f_buf_i, f_buf_v, f_buf_i3, f_buf1_i, f_buf2_i, f_buf_s, f_buf_p) 630 631 USE icosa … … 635 636 USE write_field 636 637 USE vertical_interp_mod 637 TYPE(t_field),POINTER :: f_ps(:), f_phis(:), f_u(:), f_theta_rhodz(:), f_ dps(:), &638 TYPE(t_field),POINTER :: f_ps(:), f_phis(:), f_u(:), f_theta_rhodz(:), f_q(:), f_dps(:), & 638 639 f_buf_i(:), f_buf_v(:), f_buf_i3(:), f_buf1_i(:), f_buf2_i(:), f_buf_s(:), f_buf_p(:) 639 640 640 641 REAL(rstd) :: out_pression_lev 641 642 CHARACTER(LEN=255) :: str_pression 643 CHARACTER(LEN=255) :: physics_type 642 644 643 645 out_pression_level=0 … … 661 663 ! Temperature 662 664 CALL theta_rhodz2temperature(f_ps,f_theta_rhodz,f_buf_i) ; 663 CALL writefield("T",f_buf_i) 664 665 IF (out_pression_level<=preff .AND. out_pression_level > 0) THEN 666 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,out_pression_level) 667 CALL writefield("T"//TRIM(str_pression),f_buf_s) 665 666 CALL getin('physics',physics_type) 667 IF (TRIM(physics_type)=='dcmip') THEN 668 CALL Tv2T(f_buf_i,f_q,f_buf1_i) 669 CALL writefield("T",f_buf1_i) 670 IF (out_pression_level<=preff .AND. out_pression_level > 0) THEN 671 CALL vertical_interp(f_ps,f_buf1_i,f_buf_s,out_pression_level) 672 CALL writefield("T"//TRIM(str_pression),f_buf_s) 673 ENDIF 674 ELSE 675 CALL writefield("T",f_buf_i) 676 IF (out_pression_level<=preff .AND. out_pression_level > 0) THEN 677 CALL vertical_interp(f_ps,f_buf_i,f_buf_s,out_pression_level) 678 CALL writefield("T"//TRIM(str_pression),f_buf_s) 679 ENDIF 668 680 ENDIF 669 681 670 682 ! velocity components 671 683 CALL un2ulonlat(f_u, f_buf_i3, f_buf1_i, f_buf2_i) … … 739 751 END DO 740 752 END SUBROUTINE un2ulonlat 741 753 754 SUBROUTINE Tv2T(f_Tv, f_q, f_T) 755 USE icosa 756 IMPLICIT NONE 757 TYPE(t_field), POINTER :: f_TV(:) 758 TYPE(t_field), POINTER :: f_q(:) 759 TYPE(t_field), POINTER :: f_T(:) 760 761 REAL(rstd),POINTER :: Tv(:,:), q(:,:,:), T(:,:) 762 INTEGER :: ind 763 764 DO ind=1,ndomain 765 CALL swap_dimensions(ind) 766 CALL swap_geometry(ind) 767 Tv=f_Tv(ind) 768 q=f_q(ind) 769 T=f_T(ind) 770 T=Tv/(1+0.608*q(:,:,1)) 771 END DO 772 773 END SUBROUTINE Tv2T 774 742 775 END MODULE caldyn_gcm_mod -
codes/icosagcm/trunk/src/physics_dcmip.f90
r106 r110 172 172 173 173 ! q=0 174 out_i=T174 ! out_i=T 175 175 176 176 CALL simple_physics(iim*jjm, llm, dt, lat, tfi, qfi , ufi, vfi, pmid, pint, pdel, 1/pdel, ps, precl, testcase) … … 198 198 ENDDO 199 199 200 out_i=q200 ! out_i=q 201 201 202 202 utemp=utemp-u … … 496 496 do i=1,pcols 497 497 qsat = epsilo*e0/pmid(i,k)*exp(-latvap/rh2o*((1._r8/t(i,k))-1._r8/T0)) ! saturation specific humidity 498 out_i(i,llm+1-k)=q(i,k)-qsat 498 499 if (q(i,k) > qsat) then ! saturated? 499 500 tmp = 1._r8/dtime*(q(i,k)-qsat)/(1._r8+(latvap/cpair)*(epsilo*latvap*qsat/(rair*t(i,k)**2))) -
codes/icosagcm/trunk/src/timeloop_gcm.f90
r109 r110 114 114 115 115 CALL guided(it*dt,f_ps,f_theta_rhodz,f_u,f_q) 116 CALL caldyn(it,f_phis,f_ps,f_theta_rhodz,f_u, f_ dps, f_dtheta_rhodz, f_du)116 CALL caldyn(it,f_phis,f_ps,f_theta_rhodz,f_u, f_q, f_dps, f_dtheta_rhodz, f_du) 117 117 CALL advect_tracer(f_ps,f_u,f_q) 118 CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q)119 118 120 119 SELECT CASE (TRIM(scheme)) … … 138 137 139 138 END SELECT 139 140 CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 140 141 141 142 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.