Changeset 3390 for LMDZ6/trunk/libf
- Timestamp:
- Sep 13, 2018, 10:54:19 PM (6 years ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.F90
r3388 r3390 84 84 !$OMP THREADPRIVATE(fco2_lu_inst) 85 85 86 ! Following 4 fields will be allocated and initialized in surf_land_orchidee 87 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_nbp_inst ! flux CO2 from land at one time step 88 !$OMP THREADPRIVATE(fCO2_nbp_inst) 89 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_nep_inst ! flux CO2 from land at one time step 90 !$OMP THREADPRIVATE(fCO2_nep_inst) 91 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_fLuc_inst ! Emission from land use change at one time step 92 !$OMP THREADPRIVATE(fCO2_fLuc_inst) 93 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_fFire_inst ! flux CO2 from land at one time step 94 !$OMP THREADPRIVATE(fCO2_fFire_inst) 95 96 86 97 ! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE 87 98 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0 … … 150 161 !$OMP THREADPRIVATE(zcfields_out) 151 162 152 TYPE, PUBLIC :: 163 TYPE, PUBLIC :: co2_trac_type 153 164 CHARACTER(len = 8) :: name ! Tracer name in tracer.def 154 165 INTEGER :: id ! Index in total tracer list, tr_seri … … 660 671 READ(200,*) nbcf 661 672 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf 662 IF (.NOT. ALLOCATED(cfname_root))ALLOCATE(cfname_root(nbcf))663 IF (.NOT. ALLOCATED(cfintent_root))ALLOCATE(cfintent_root(nbcf))664 IF (.NOT. ALLOCATED(cfmod1_root))ALLOCATE(cfmod1_root(nbcf))665 IF (.NOT. ALLOCATED(cfmod2_root))ALLOCATE(cfmod2_root(nbcf))666 IF (.NOT. ALLOCATED(cftext_root))ALLOCATE(cftext_root(nbcf))667 IF (.NOT. ALLOCATED(cfunits_root))ALLOCATE(cfunits_root(nbcf))668 IF (.NOT. ALLOCATED(mask_in_root))ALLOCATE(mask_in_root(nbcf))669 IF (.NOT. ALLOCATED(mask_out_root))ALLOCATE(mask_out_root(nbcf))673 ALLOCATE(cfname_root(nbcf)) 674 ALLOCATE(cfintent_root(nbcf)) 675 ALLOCATE(cfmod1_root(nbcf)) 676 ALLOCATE(cfmod2_root(nbcf)) 677 ALLOCATE(cftext_root(nbcf)) 678 ALLOCATE(cfunits_root(nbcf)) 679 ALLOCATE(mask_in_root(nbcf)) 680 ALLOCATE(mask_out_root(nbcf)) 670 681 671 682 nbcf_in=0 672 683 nbcf_out=0 684 673 685 DO iq=1,nbcf 674 686 WRITE(lunout,*) 'infofields : field=',iq … … 687 699 WRITE(lunout,*) 'coupling field: ',cfname_root(iq), & 688 700 ', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq) 689 IF ((TRIM(cfintent_root(iq)).NE.'OUT') .AND. (nbcf_in.LE.nbcf)) THEN 690 nbcf_in=nbcf_in+1 691 mask_in_root(iq)=.TRUE. 692 mask_out_root(iq)=.FALSE. 693 ELSE IF ((TRIM(cfintent_root(iq)).EQ.'OUT') .AND. (nbcf_out.LE.nbcf)) THEN 694 nbcf_out=nbcf_out+1 695 mask_in_root(iq)=.FALSE. 696 mask_out_root(iq)=.TRUE. 701 IF (nbcf_in+nbcf_out.LT.nbcf) THEN 702 IF (cfintent_root(iq).NE.'OUT') THEN 703 nbcf_in=nbcf_in+1 704 mask_in_root(iq)=.TRUE. 705 mask_out_root(iq)=.FALSE. 706 ELSE IF (cfintent_root(iq).EQ.'OUT') THEN 707 nbcf_out=nbcf_out+1 708 mask_in_root(iq)=.FALSE. 709 mask_out_root(iq)=.TRUE. 710 ENDIF 697 711 ELSE 698 WRITE(lunout,*) 'abort_gcm --- nbcf : ',nbcf699 WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in712 WRITE(lunout,*) 'abort_gcm --- nbcf : ',nbcf 713 WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in 700 714 WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out 701 715 CALL abort_gcm('infocfields_init','Problem in the definition of the coupling fields',1) … … 710 724 ENDIF ! level_coupling_esm 711 725 712 IF (nbcf_out .EQ. 0) nbcf_out=-1713 IF (nbcf_in .EQ. 0) nbcf_in=-1714 715 726 ENDIF ! (is_mpi_root .AND. is_omp_root) 716 727 !$OMP BARRIER … … 720 731 CALL bcast(nbcf_out) 721 732 722 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf =',nbcf723 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in733 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf =',nbcf 734 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in 724 735 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out 725 736 726 IF ((nbcf.GT.0) .AND. (.NOT. ALLOCATED(cfname)))ALLOCATE(cfname(nbcf))727 IF ((nbcf_in.GT.0) .AND. (.NOT. ALLOCATED(cfname_in)))ALLOCATE(cfname_in(nbcf_in))728 IF ((nbcf_in.GT.0) .AND. (.NOT. ALLOCATED(cftext_in)))ALLOCATE(cftext_in(nbcf_in))729 IF ((nbcf_out.GT.0) .AND. (.NOT. ALLOCATED(cfname_out)))ALLOCATE(cfname_out(nbcf_out))730 IF ((nbcf_out.GT.0) .AND. (.NOT. ALLOCATED(cftext_out)))ALLOCATE(cftext_out(nbcf_out))731 IF ((nbcf.GT.0) .AND. (.NOT. ALLOCATED(cfmod1)))ALLOCATE(cfmod1(nbcf))732 IF ((nbcf.GT.0) .AND. (.NOT. ALLOCATED(cfmod2)))ALLOCATE(cfmod2(nbcf))733 IF ((nbcf_in.GT.0) .AND. (.NOT. ALLOCATED(cfunits_in)))ALLOCATE(cfunits_in(nbcf_in))734 IF ((nbcf_out.GT.0) .AND. (.NOT. ALLOCATED(cfunits_out)))ALLOCATE(cfunits_out(nbcf_out))737 ALLOCATE(cfname(nbcf)) 738 ALLOCATE(cfname_in(nbcf_in)) 739 ALLOCATE(cftext_in(nbcf_in)) 740 ALLOCATE(cfname_out(nbcf_out)) 741 ALLOCATE(cftext_out(nbcf_out)) 742 ALLOCATE(cfmod1(nbcf)) 743 ALLOCATE(cfmod2(nbcf)) 744 ALLOCATE(cfunits_in(nbcf_in)) 745 ALLOCATE(cfunits_out(nbcf_out)) 735 746 736 747 IF (is_mpi_root .AND. is_omp_root) THEN 737 748 738 IF (nbcf.GT.0) cfname=cfname_root739 IF (nbcf_in.GT.0) cfname_in=PACK(cfname_root,mask_in_root)749 IF (nbcf.GT.0) cfname=cfname_root 750 IF (nbcf_in.GT.0) cfname_in=PACK(cfname_root,mask_in_root) 740 751 IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root) 741 IF (nbcf_in.GT.0) cftext_in=PACK(cftext_root,mask_in_root)752 IF (nbcf_in.GT.0) cftext_in=PACK(cftext_root,mask_in_root) 742 753 IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root) 743 IF (nbcf.GT.0) cfmod1=cfmod1_root744 IF (nbcf.GT.0) cfmod2=cfmod2_root745 IF (nbcf_in.GT.0) cfunits_in=PACK(cfunits_root,mask_in_root)754 IF (nbcf.GT.0) cfmod1=cfmod1_root 755 IF (nbcf.GT.0) cfmod2=cfmod2_root 756 IF (nbcf_in.GT.0) cfunits_in=PACK(cfunits_root,mask_in_root) 746 757 IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root) 747 758 … … 752 763 753 764 DO iq=1,nbcf 754 IF (cfmod1(iq) == "ORC") nbcf_in_orc=nbcf_in_orc+1755 IF (cfmod1(iq) == "NEMO") nbcf_in_nemo =nbcf_in_nemo+1756 IF (cfmod1(iq) == "INCA") nbcf_in_inca =nbcf_in_inca+1757 IF (cfmod1(iq) == "ALL") nbcf_in_orc=nbcf_in_orc+1! ALL = ORC/NEMO/INCA758 IF (cfmod1(iq) == "ALL") nbcf_in_nemo=nbcf_in_nemo+1 ! ALL = ORC/NEMO/INCA759 IF (cfmod1(iq) == "ALL") nbcf_in_inca=nbcf_in_inca+1 ! ALL = ORC/NEMO/INCA760 IF (cfmod1(iq) == "ANT") nbcf_in_ant=nbcf_in_ant+1765 IF (cfmod1(iq) == "ORC") nbcf_in_orc = nbcf_in_orc + 1 766 IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1 767 IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1 768 IF (cfmod1(iq) == "ALL") nbcf_in_orc = nbcf_in_orc + 1 ! ALL = ORC/NEMO/INCA 769 IF (cfmod1(iq) == "ALL") nbcf_in_nemo = nbcf_in_nemo + 1 ! ALL = ORC/NEMO/INCA 770 IF (cfmod1(iq) == "ALL") nbcf_in_inca = nbcf_in_inca + 1 ! ALL = ORC/NEMO/INCA 771 IF (cfmod1(iq) == "ANT") nbcf_in_ant = nbcf_in_ant + 1 761 772 ENDDO 762 773 … … 769 780 CALL bcast(nbcf_in_ant) 770 781 771 WRITE(lunout,*) 'nbcf_in_orc ',nbcf_in_orc772 WRITE(lunout,*) 'nbcf_in_nemo ',nbcf_in_nemo773 WRITE(lunout,*) 'nbcf_in_inca ',nbcf_in_inca774 WRITE(lunout,*) 'nbcf_in_ant ',nbcf_in_ant782 WRITE(lunout,*) 'nbcf_in_orc =',nbcf_in_orc 783 WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo 784 WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca 785 WRITE(lunout,*) 'nbcf_in_ant =',nbcf_in_ant 775 786 776 787 IF (nbcf_in.GT.0) THEN … … 797 808 ENDIF 798 809 799 IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in810 IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in 800 811 IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out 801 812 802 IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in813 IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in 803 814 IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out 804 815 … … 806 817 IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2 807 818 808 IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in819 IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in 809 820 IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out 810 821 811 IF (nbcf_in.GT.0) WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in822 IF (nbcf_in.GT.0) WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in 812 823 IF (nbcf_out.GT.0) WRITE(*,*)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out 813 824 … … 819 830 ENDIF ! planet_type 820 831 821 IF ((nbcf_in.GT.0) .AND. (.NOT. ALLOCATED(zcfields_in))) THEN 822 ALLOCATE(zcfields_in(klon,nbcf_in),stat=error) 823 IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation zcfields_in',1) 824 ENDIF 825 IF ((nbcf_out.GT.0) .AND. (.NOT. ALLOCATED(zcfields_out))) THEN 826 ALLOCATE(zcfields_out(klon,nbcf_out),stat=error) 827 IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation zcfields_out',1) 828 ENDIF 832 ALLOCATE(zcfields_in(klon,nbcf_in),stat=error) 833 IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation zcfields_in',1) 834 ALLOCATE(zcfields_out(klon,nbcf_out),stat=error) 835 IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation zcfields_out',1) 829 836 830 837 END SUBROUTINE infocfields_init
Note: See TracChangeset
for help on using the changeset viewer.
